home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / HelpACoder45984132002.psc / Form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2002-01-04  |  8.3 KB  |  274 lines
  1. VERSION 5.00
  2. Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  5. Begin VB.Form Form1 
  6.    Caption         =   "HelpACoder"
  7.    ClientHeight    =   7695
  8.    ClientLeft      =   2940
  9.    ClientTop       =   2145
  10.    ClientWidth     =   9180
  11.    Icon            =   "Form1.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   7695
  14.    ScaleWidth      =   9180
  15.    Begin MSComDlg.CommonDialog cd 
  16.       Left            =   8520
  17.       Top             =   6600
  18.       _ExtentX        =   847
  19.       _ExtentY        =   847
  20.       _Version        =   393216
  21.    End
  22.    Begin InetCtlsObjects.Inet Inet 
  23.       Left            =   8520
  24.       Top             =   7080
  25.       _ExtentX        =   1005
  26.       _ExtentY        =   1005
  27.       _Version        =   393216
  28.    End
  29.    Begin MSComctlLib.ListView list1 
  30.       Height          =   7695
  31.       Left            =   0
  32.       TabIndex        =   0
  33.       Top             =   0
  34.       Width           =   9135
  35.       _ExtentX        =   16113
  36.       _ExtentY        =   13573
  37.       LabelWrap       =   -1  'True
  38.       HideSelection   =   -1  'True
  39.       FullRowSelect   =   -1  'True
  40.       _Version        =   393217
  41.       ForeColor       =   -2147483640
  42.       BackColor       =   -2147483643
  43.       BorderStyle     =   1
  44.       Appearance      =   1
  45.       NumItems        =   0
  46.    End
  47.    Begin VB.Menu File 
  48.       Caption         =   "File"
  49.       Begin VB.Menu Refresh 
  50.          Caption         =   "Refresh"
  51.       End
  52.    End
  53.    Begin VB.Menu Tools 
  54.       Caption         =   "Tools"
  55.       Begin VB.Menu Download 
  56.          Caption         =   "Download Selected"
  57.       End
  58.       Begin VB.Menu Upload 
  59.          Caption         =   "Upload"
  60.       End
  61.       Begin VB.Menu Email 
  62.          Caption         =   "Email"
  63.       End
  64.    End
  65. Attribute VB_Name = "Form1"
  66. Attribute VB_GlobalNameSpace = False
  67. Attribute VB_Creatable = False
  68. Attribute VB_PredeclaredId = True
  69. Attribute VB_Exposed = False
  70. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  71. 'This is an update to my last two versions of HelpACoder this one'
  72. 'now has the option to upload your files though right now it is  '
  73. 'sent to a request and i will check them before adding but i plan'
  74. 'to allow in future versions direct upload but there are two     '
  75. 'problems 1)I need to create a filter checking for already added '
  76. 'projects under that name and other things. And 2) i dont know if'
  77. 'it will work im thinking what if two people try to upload at the'
  78. 'same time do to the way i deal with it one will be dropped if   '
  79. 'not both but im not sure the reason i think this is because it  '
  80. 'may load someone else saves then they save, it dropped the first'
  81. 'one, is there a way i can save a line to a file rather than     '
  82. 'loading and resaving? just like add a line no replacement at all'
  83. 'Please help thanks                                              '
  84. 'Please leave votes and comments.                                '
  85. 'Thankyou for downloading this program.                          '
  86. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  87. 'If you use this source in your program do not give me credit in '
  88. 'any way this code is now yours to use,though please do visit my '
  89. 'Site    www.jemisp.com/Visualcode                               '
  90. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  91. 'used to email
  92. Private Declare Function ShellExecute& Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)
  93. Private tlist As ListItem
  94. 'provides extra info on project
  95. Private Pinfo(5000) As String
  96. Public Sub GetNew()
  97. 'it will error if no connection
  98.     On Error Resume Next
  99.     '
  100. 'dim some splitters
  101.     Dim splitter() As String
  102.     Dim split2() As String
  103.     '
  104. 'If it errors then we are done
  105.     On Error GoTo done
  106.     '
  107. 'Load File
  108.     frmSplash.Status.Caption = "Loading File..."
  109.     Cfile = Inet.OpenURL("www.jemisp.com/Visualcode/Want.rsd", icString)
  110.     'Open App.Path & "\want.rsd" For Input As #1
  111.     'Do Until EOF(1)
  112.     'Line Input #1, temp
  113.     'Cfile = Cfile & temp & vbCrLf
  114.     'Loop
  115.     'Close #1
  116.     '
  117. 'Split it into lines
  118.     splitter() = Split(Cfile, vbCrLf)
  119.     '
  120. For i = 0 To (UBound(splitter) + 1)
  121. frmSplash.Status.Caption = "Adding Files..."
  122. 'info = the i number if i was 5 then the 5th number
  123.     Info = splitter(i)
  124.     split2() = Split(Info, "
  125.     '
  126. 'This command is what we use when adding to a listview
  127.     Set tlist = list1.ListItems.Add
  128.     '
  129. 'this is what we want to add
  130.     tlist.SubItems(1) = split2(0)
  131.     tlist.SubItems(2) = split2(1)
  132.     tlist.SubItems(3) = split2(2)
  133.     tlist.SubItems(4) = split2(3)
  134.     '
  135. 'Put the info and download location in a variable
  136. 'for later use
  137.     Pinfo(i) = split2(4) & "
  138. " & split2(5) & "
  139. " & split2(2) & "
  140. " & split2(0)
  141.     '
  142. Next i
  143. done:
  144. End Sub
  145. Private Sub Download_Click()
  146. If list1.ListItems.Count <= 0 Then Exit Sub
  147. On Error Resume Next
  148. 'dim a splitter
  149.     Dim splitter() As String
  150.     '
  151. 'Tmp2 = selected projects info
  152.     tmp2 = Pinfo(list1.SelectedItem.Index - 1)
  153.     '
  154. 'splitter = the split version of tmp2
  155.     splitter() = Split(tmp2, "
  156.     '
  157. 'If no downloadable file then leave sub
  158.     If splitter(1) = "None" Then MsgBox "No Download Available": Exit Sub
  159.     '
  160. 'set the default extension for cd or Common Dialog
  161.     cd.DefaultExt = Right(splitter(1), 4)
  162.     cd.Filter = "Original File Type|*" & Right(splitter(1), 4) & "|"
  163.     '
  164. 'Make it make them save as original file extension
  165.     cd.Filter = "Original File Type|*" & Right(splitter(1), 4) & "|"
  166.     '
  167. 'let them chose a destination to save to
  168.     cd.ShowSave
  169.     '
  170. 'Check and be sure theres a file
  171.     If cd.FileName = "" Then Exit Sub
  172.     '
  173. 'Now that we found where it is download it Splitter(1) is the url
  174.     URLDownloadToFile 0, splitter(1), cd.FileName, 0, 0
  175.     '
  176. End Sub
  177. Private Sub Email_Click()
  178. On Error Resume Next
  179. 'dim a splitter
  180.     Dim splitter() As String
  181.     '
  182. 'Tmp2 = selected projects info
  183.     tmp2 = Pinfo(list1.SelectedItem.Index - 1)
  184.     '
  185. 'splitter = the split version of tmp2
  186.     splitter() = Split(tmp2, "
  187.     '
  188. 'Email the person
  189.     ShellExecute Form1.hwnd, "Open", "Mailto:" & splitter(2), "", "", True
  190.     '
  191. End Sub
  192. Private Sub Form_Load()
  193. 'Add an empty column
  194.     list1.ColumnHeaders.Add 1, , "", 0
  195.     '
  196. 'Add filled columns
  197.     list1.ColumnHeaders.Add 2, , "Author", 2000
  198.     list1.ColumnHeaders.Add 3, , "Program Name", 3400
  199.     list1.ColumnHeaders.Add 4, , "E-mail", 2130
  200.     list1.ColumnHeaders.Add 5, , "Type", 1500
  201.     '
  202. 'Now make it use the columns
  203.     list1.View = lvwReport
  204.     '
  205. 'Get info
  206.     GetNew
  207.     '
  208. End Sub
  209. Private Sub Form_Unload(Cancel As Integer)
  210. 'Close all forms
  211.     End
  212.     '
  213. End Sub
  214. Private Sub list1_Click()
  215. On Error Resume Next
  216. 'dim a splitter
  217.     Dim splitter() As String
  218.     '
  219. 'Tmp2 = selected projects info
  220.     tmp2 = Pinfo(list1.SelectedItem.Index - 1)
  221.     '
  222. 'splitter = the split version of tmp2
  223.     splitter() = Split(tmp2, "
  224.     '
  225. 'Email the person
  226.     Email.Caption = "Email " & splitter(3)
  227.     '
  228. End Sub
  229. Private Sub list1_DblClick()
  230. On Error Resume Next
  231. 'used because if nothing in the list it will error
  232. 'and if no internet connection found it will be empty
  233.     On Error Resume Next
  234.     '
  235. 'dim a splitter
  236.     Dim splitter() As String
  237.     '
  238. 'Tmp2 = selected projects info
  239.     tmp2 = Pinfo(list1.SelectedItem.Index - 1)
  240.     '
  241. 'splitter = the split version of tmp2
  242.     splitter() = Split(tmp2, "
  243.     '
  244. 'The info textbox is = to the info
  245.     Form2.Text1.Text = splitter(0)
  246.     '
  247. 'Show form2
  248.     Form2.Show
  249.     '
  250. End Sub
  251. Private Sub list1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  252. 'show the menu
  253.     If Button And vbRightButton Then
  254.     PopupMenu Tools, 23, x, y
  255.     End If
  256.     '
  257. End Sub
  258. Private Sub Refresh_Click()
  259. 'empty the information variable
  260.     For i = 0 To 5000
  261.     Pinfo(i) = ""
  262.     Next i
  263.     '
  264. 'clear the list
  265.     list1.ListItems.Clear
  266.     '
  267. 'Get New Info
  268.     GetNew
  269.     '
  270. End Sub
  271. Private Sub Upload_Click()
  272. Form3.Show
  273. End Sub
  274.