RC4 Encoder Command Line

Unit ConTools.inc

var
  SoundFrequency: Integer;

function textattribute: word;
var
  csbi: _CONSOLE_SCREEN_BUFFER_INFO;
begin
  if getconsolescreenbufferinfo(getstdhandle(STD_OUTPUT_HANDLE), csbi) then
    result := csbi.wAttributes else
    result := 0;
end;

procedure settextattribute(attr: word);
begin
  setconsoletextattribute(getstdhandle(STD_OUTPUT_HANDLE), attr);
end;

procedure ClrEol;
var
  tC: tCoord;
  Len, Nw: Cardinal;
  Cbi: TConsoleScreenBufferInfo;
begin
  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), cbi);
  len := cbi.dwsize.x - cbi.dwcursorposition.x;
  tc.x := cbi.dwcursorposition.x;
  tc.y := cbi.dwcursorposition.y;
  FillConsoleOutputAttribute(GetStdHandle(STD_OUTPUT_HANDLE), textattribute, len, tc, nw);
  FillConsoleOutputCharacter(GetStdHandle(STD_OUTPUT_HANDLE), #32, len, tc, nw);
end;

procedure ClrScr;
var
  tc: tcoord;
  nw: Cardinal;
  cbi: TConsoleScreenBufferInfo;
begin
  getConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), cbi);
  tc.x := 0;
  tc.y := 0;
  FillConsoleOutputAttribute(GetStdHandle(STD_OUTPUT_HANDLE), textattribute, cbi.dwsize.x * cbi.dwsize.y, tc, nw);
  FillConsoleOutputCharacter(GetStdHandle(STD_OUTPUT_HANDLE), #32, cbi.dwsize.x * cbi.dwsize.y, tc, nw);
  setConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), tc);
end;

function WhereX: integer;
var
  cbi: TConsoleScreenBufferInfo;
begin
  getConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), cbi);
  result := tcoord(cbi.dwCursorPosition).x + 1
end;

function WhereY: integer;
var
  cbi: TConsoleScreenBufferInfo;
begin
  getConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), cbi);
  result := tcoord(cbi.dwCursorPosition).y + 1
end;

procedure GotoXY(const x, y: integer);
var
  coord: tcoord;
begin
  coord.x := x - 1;
  coord.y := y - 1;
  setConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), coord);
end;

procedure FlushInputBuffer;
begin
  FlushConsoleInputBuffer(GetStdHandle(STD_INPUT_HANDLE))
end;

function keypressed: boolean;
var
  NumberOfEvents: Cardinal;
begin
  GetNumberOfConsoleInputEvents(GetStdHandle(STD_INPUT_HANDLE), NumberOfEvents);
  result := NumberOfEvents > 0;
end;

function ReadKey: Char;
var
  NumRead: Cardinal;
  InputRec: TInputRecord;
begin
  while ((not ReadConsoleInput(GetStdHandle(STD_INPUT_HANDLE), InputRec, 1, NumRead)) or (InputRec.EventType <> KEY_EVENT)) do ;
  Result := InputRec.Event.KeyEvent.AsciiChar;
end;

procedure Sound(Freq, duration: Cardinal);
begin
  soundfrequency := freq;
  windows.beep(Freq, duration);
end;

procedure NoSound;
begin
  windows.beep(SoundFrequency, 0);
end;

procedure ConsoleEnd;
begin
  if isconsole then begin
    if wherex > 1 then writeln;
    settextattribute(FOREGROUND_GREEN or FOREGROUND_INTENSITY);
    setfocus(GetCurrentProcess);
    write('Press any key to continue.');
    FlushInputBuffer;
    ReadKey;
    FlushInputBuffer;
  end;
end;

Unit FileTools.inc

const
  fmOpenRead = $0000;
  fmOpenWrite = $0001;
  fmOpenReadWrite = $0002;

  fmShareCompat = $0000;
  fmShareExclusive = $0010;
  fmShareDenyWrite = $0020;
  fmShareDenyRead = $0030;
  fmShareDenyNone = $0040;

function FileExists(const FileName: string; dir: boolean = false): Boolean;
var
  hidate, lodate: word;
  Handle: THandle;
  FindData: TWin32FindData;
  LocalFileTime: TFileTime;

type
  LongRec = packed record
    Lo, Hi: Word;
  end;

  function SubFileExists: Boolean;
  begin
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    result := FileTimeToDosDateTime(LocalFileTime, HiDate, LoDate);
  end;
begin
  result := false;
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    case dir of
      TRUE: if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0
        then
          result := SubFileExists;
      FALSE: if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0
        then
          result := SubFileExists;
    end;
  end;
end;

function CutPathname(s: string): string;
var
  i: integer;
begin
  result := s;
  for i := length(s) downto 1 do
    // Von hinten den Backslash suchen. Wenn gefunden alles ab Backslash kopieren
    if s[i] = '\' then
    begin
      result := copy(s, i + 1, length(s));
        // Nach dem ersten Backslash beenden
      break;
    end;
end;

function CutFilename(s: string): string;
var
  i: integer;
begin
  result := s;
  for i := length(s) downto 1 do
    // Von hinten den Backslash suchen. Wenn gefunden alles bis inkl. Backslash kopieren
    if s[i] = '\' then
    begin
      result := copy(s, 1, i);
        // Nach dem ersten Backslash beenden
      break;
    end;
end;

function HasBackslash(Dir: string): Boolean;
begin
  if length(Dir) > 0 then
    result := Dir[length(Dir)] = '\';
end;

function DelBackSlash(Dir: string): string;
begin
  result := Dir;
  if (length(dir) > 0) and (Dir[length(Dir)] = '\') then
    SetLength(Result, Length(Result) - 1);
end;

function ForceDirectories(Dir: string): Boolean;
begin
  Result := True;
  if Length(Dir) = 0 then
    exit;
  if HasBackslash(Dir) then
    Dir := DelBackSlash(Dir);
  if (Length(Dir) < 3) or FileExists(Dir, True)
    or (CutFilename(Dir) = Dir) then
    Exit; // avoid 'xyz:\' problem.
  Result := ForceDirectories(CutFilename(Dir)) and CreateDirectory(PChar(Dir),
    nil);
end;

function ChangeFileExt(const szFilename, szNewExt: string): string;
var
  rpos: integer;
begin
  rpos := length(szFilename);
  if (pos('.', szFilename) > 0) then
    while (szFilename[rpos] <> '.') and (rpos > 0) do
      dec(rpos);

  Result := copy(szFilename, 1, rpos - 1) + szNewExt;
end;

function GetFileSize(szFile: PChar): Int64;
var
  fFile: THandle;
  wfd: TWIN32FINDDATA;
begin
  result := 0;
  if not FileExists(szFile) then
    exit;
  fFile := FindFirstfile(pchar(szFile), wfd);
  if fFile = INVALID_HANDLE_VALUE then
    exit;
  result := (wfd.nFileSizeHigh * (Int64(MAXDWORD) + 1)) + wfd.nFileSizeLow;
  windows.FindClose(fFile);
end;

function FileCreate(const FileName: string): Integer;
begin
  Result := Integer(CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
end;

function FileOpen(const FileName: string; Mode: LongWord): Integer;
const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
  Result := Integer(CreateFile(PChar(FileName), AccessMode[Mode and 3],
    ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL, 0));
end;

function FileSeek(Handle, Offset, Origin: Integer): Integer;
begin
  Result := SetFilePointer(THandle(Handle), Offset, nil, Origin);
end;

function FileRead(Handle: Integer; var Buffer; Count: LongWord): Integer;
begin
  if not ReadFile(THandle(Handle), Buffer, Count, LongWord(Result), nil) then
    Result := -1;
end;

function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;
begin
  if not WriteFile(THandle(Handle), Buffer, Count, LongWord(Result), nil) then
    Result := -1;
end;

procedure FileClose(Handle: Integer);
begin
  CloseHandle(THandle(Handle));
end;

function putbinrestohdd(binresname, path: string): Boolean;
var
  hi, hg, ResSize,
    SizeWritten, hFile: cardinal;
begin
  result := false;
  hi := FindResource(hInstance, @binresname[1], 'BINRES');
  if hi <> 0 then
  begin
    hg := LoadResource(hInstance, hi);
    if hg <> 0 then
    begin
      ResSize := SizeofResource(hInstance, hi);
      hFile := CreateFile(@path[1], GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CREATE_ALWAYS,
        FILE_ATTRIBUTE_ARCHIVE, 0);
      if hFile <> INVALID_HANDLE_VALUE then
      try
        result := (WriteFile(hFile, LockResource(HG)^, ResSize,
          SizeWritten, nil) and (SizeWritten = ResSize));
      finally
        CloseHandle(hFile);
      end;
    end;
  end;
end;

function GetImageLinkTimeStamp(const FileName: string): DWORD;
const
  INVALID_SET_FILE_POINTER = DWORD(-1);
  BorlandMagicTimeStamp = $2A425E19;
  FileTime1970: TFileTime = (dwLowDateTime: $D53E8000; dwHighDateTime:
    $019DB1DE);
type
  PImageSectionHeaders = ^TImageSectionHeaders;
  TImageSectionHeaders = array[Word] of TImageSectionHeader;
type
  PImageResourceDirectory = ^TImageResourceDirectory;
  TImageResourceDirectory = packed record
    Characteristics: DWORD;
    TimeDateStamp: DWORD;
    MajorVersion: Word;
    MinorVersion: Word;
    NumberOfNamedEntries: Word;
    NumberOfIdEntries: Word;
  end;
var
  FileHandle: THandle;
  BytesRead: DWORD;
  ImageDosHeader: TImageDosHeader;
  ImageNtHeaders: TImageNtHeaders;
  SectionHeaders: PImageSectionHeaders;
  Section: Word;
  ResDirRVA: DWORD;
  ResDirSize: DWORD;
  ResDirRaw: DWORD;
  ResDirTable: TImageResourceDirectory;
  FileTime: TFileTime;
begin
  Result := 0;
  // Open file for read access
  FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil,
    OPEN_EXISTING, 0, 0);
  if (FileHandle <> INVALID_HANDLE_VALUE) then
  try
    // Read MS-DOS header to get the offset of the PE32 header
    // (not required on WinNT based systems - but mostly available)
    if not ReadFile(FileHandle, ImageDosHeader, SizeOf(TImageDosHeader),
      BytesRead, nil) or (BytesRead <> SizeOf(TImageDosHeader)) or
      (ImageDosHeader.e_magic <> IMAGE_DOS_SIGNATURE) then
    begin
      ImageDosHeader._lfanew := 0;
    end;
    // Read PE32 header (including optional header
    if (SetFilePointer(FileHandle, ImageDosHeader._lfanew, nil, FILE_BEGIN) =
      INVALID_SET_FILE_POINTER) then
    begin
      Exit;
    end;
    if not (ReadFile(FileHandle, ImageNtHeaders, SizeOf(TImageNtHeaders),
      BytesRead, nil) and (BytesRead = SizeOf(TImageNtHeaders))) then
    begin
      Exit;
    end;
    // Validate PE32 image header
    if (ImageNtHeaders.Signature <> IMAGE_NT_SIGNATURE) then
    begin
      Exit;
    end;
    // Seconds since 1970 (UTC)
    Result := ImageNtHeaders.FileHeader.TimeDateStamp;

    // Check for Borlands magic value for the link time stamp
    // (we take the time stamp from the resource directory table)
    if (ImageNtHeaders.FileHeader.TimeDateStamp = BorlandMagicTimeStamp) then
      with ImageNtHeaders, FileHeader, OptionalHeader do
      begin
      // Validate Optional header
        if (SizeOfOptionalHeader < IMAGE_SIZEOF_NT_OPTIONAL_HEADER) or
          (Magic <> IMAGE_NT_OPTIONAL_HDR_MAGIC) then
        begin
          Exit;
        end;
      // Read section headers
        SectionHeaders :=
          GetMemory(NumberOfSections * SizeOf(TImageSectionHeader));
        if Assigned(SectionHeaders) then
        try
          if (SetFilePointer(FileHandle,
            SizeOfOptionalHeader - IMAGE_SIZEOF_NT_OPTIONAL_HEADER, nil,
            FILE_CURRENT) = INVALID_SET_FILE_POINTER) then
          begin
            Exit;
          end;
          if not (ReadFile(FileHandle, SectionHeaders^, NumberOfSections *
            SizeOf(TImageSectionHeader), BytesRead, nil) and (BytesRead =
            NumberOfSections * SizeOf(TImageSectionHeader))) then
          begin
            Exit;
          end;
        // Get RVA and size of the resource directory
          with DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE] do
          begin
            ResDirRVA := VirtualAddress;
            ResDirSize := Size;
          end;
        // Search for section which contains the resource directory
          ResDirRaw := 0;
          for Section := 0 to NumberOfSections - 1 do
            with SectionHeaders[Section] do
              if (VirtualAddress <= ResDirRVA) and
                (VirtualAddress + SizeOfRawData >= ResDirRVA + ResDirSize) then
              begin
                ResDirRaw := PointerToRawData - (VirtualAddress - ResDirRVA);
                Break;
              end;
        // Resource directory table found?
          if (ResDirRaw = 0) then
          begin
            Exit;
          end;
        // Read resource directory table
          if (SetFilePointer(FileHandle, ResDirRaw, nil, FILE_BEGIN) =
            INVALID_SET_FILE_POINTER) then
          begin
            Exit;
          end;
          if not (ReadFile(FileHandle, ResDirTable,
            SizeOf(TImageResourceDirectory), BytesRead, nil) and
            (BytesRead = SizeOf(TImageResourceDirectory))) then
          begin
            Exit;
          end;
        // Convert from DosDateTime to SecondsSince1970
          if DosDateTimeToFileTime(HiWord(ResDirTable.TimeDateStamp),
            LoWord(ResDirTable.TimeDateStamp), FileTime) then
          begin
          // FIXME: Borlands linker uses the local system time
          // of the user who linked the executable image file.
          // (is that information anywhere?)
            Result := (ULARGE_INTEGER(FileTime).QuadPart -
              ULARGE_INTEGER(FileTime1970).QuadPart) div 10000000;
          end;
        finally
          FreeMemory(SectionHeaders);
        end;
      end;
  finally
    CloseHandle(FileHandle);
  end;
end;

Unit1:

program EncodeRC4;

{$APPTYPE CONSOLE}

uses
  Windows, RC4;

const
  APPNAME = 'EncodeRC4';
  VER = '1.1';
  COPYRIGHT =
    'Copyright (c) 2004 Michael Puff'#13#10'Homepage: www.luckie-online.de';
  LF = '';

var
  SourceFile: string;
  DestFile: string;
  PW: string;

{$INCLUDE ConTools.inc}
{$INCLUDE FileTools.inc}

function Ansi2OEM(AnsiString: string): string;
begin
  ANSIString := ANSIString + #0;
  CharToOEM(PChar(ANSIString), @ANSIString[1]);
  Delete(ANSIString, Length(ANSIString), 1);
  Result := ANSIString;
end;

function Min(x, y: Cardinal): Integer;
begin
  if x < y then
    result := x
  else
    result := y;
end;

function IntToStr(Int: integer): string;
begin
  Str(Int, result);
end;

procedure Help;
resourcestring
  rsDescription = 'Verschlüsselt Dateien mit Hilfe des RC4 Algorithmuses';
  rsCmdLine = 'Syntax: EncodeRC4 Quelle Ziel';
begin
  Writeln(Ansi2OEM(rsDescription));
  Writeln(Ansi2OEM(rsCmdLine));
end;

function Encode(const SourceFile, DestFile, PW: string): DWORD;
const
  BLOCKSIZE = 1024;
var
  y: Integer;
  hInFile: Integer;
  hOutFile: Integer;
  BytesRead: Int64;
  BytesToRead: Int64;
  FileSize: Int64;
  TotalBytesWritten: Int64;
  PercentDone: Integer;
  InBuffer: array[0..BLOCKSIZE - 1] of Byte;
  OutBuffer: array[0..BLOCKSIZE - 1] of Byte;
  RC4: TRC4Context;
resourcestring
  rsProgress = 'Fortschritt: ';
begin
  SetLastError(0);
  TotalBytesWritten := 0;
  y := WhereY + 1;
  FileSize := GetFileSize(PChar(SourceFile));
  BytesToRead := FileSize;
  if BytesToRead > 0 then
  begin
    hInFile := FileOpen(SourceFile, fmOpenRead);
    if hInFile > -1 then
    begin
      hOutFile := FileCreate(DestFile);
      if hOutFile > -1 then
      begin
        RC4Init(RC4, PW);
        repeat
          // Encode stuff
          BytesRead := FileRead(hInFile, InBuffer, Min(BLOCKSIZE,
            BytesToRead));
          RC4Code(Rc4, InBuffer, OutBuffer, BytesRead);
          FileWrite(hOutFile, OutBuffer, BytesRead);
          Dec(BytesToRead, BLOCKSIZE);
          // Progress stuff
          TotalBytesWritten := TotalBytesWritten + BytesRead;
          PercentDone := (TotalBytesWritten * 100) div FileSize;
          GotoXY(1, y - 1);
          Writeln(rsProgress + IntToStr(PercentDone) + '%');
        until BytesToRead < 0;
        FileClose(hOutFile);
      end;
      FileClose(hInFile);
    end;
  end;
  result := GetLastError;
end;

var
  dwReturn: DWord;
  hConsole: THandle;
  ConsoleMode: DWORD;

resourcestring
  rsErrorParamCount = 'Anzahl der Parameter ist nicht korrekt';
  rsPW = 'Passwort: ';
  rsFileNotExists = 'Fehler: Quelldatei existiert nicht';
  rsWorkError = 'Fehler beim Bearbeiten der Datei';

begin
  case ParamCount of
    2:
      begin
        SourceFile := ParamStr(1);
        DestFile := ParamStr(2);
        if FileExists(DestFile) then
          DeleteFile(PChar(DestFile));

        Write(rsPW);
        hConsole := GetStdHandle(STD_INPUT_HANDLE);
        GetConsoleMode(hConsole, ConsoleMode);
        SetConsoleMode(hConsole, ConsoleMode and not ENABLE_ECHO_INPUT);
        ReadLn(PW);
        SetConsoleMode(hConsole, ConsoleMode or ENABLE_ECHO_INPUT);

        if FileExists(SourceFile) then
        begin
          dwReturn := Encode(SourceFile, DestFile, PW);
          if (dwReturn <> 0) and (dwReturn <> 2) then
            Writeln(rsWorkError);
        end
        else
          Writeln(rsFileNotExists);
      end
  else
    begin
      Writeln(rsErrorParamCount);
      Writeln(LF);
      Help;
    end;
  end;
  Writeln(LF);
  Writeln(APPNAME + ' - ' + VER);
  Writeln(COPYRIGHT);
end.