簡易暗号,復号化ユニット

 データやファイルに暗号を掛けたい場合があると思います。高度な機密を保ちたいという場合には答えられませんが、社内や家庭内で他の人にファイルの中身を知られたくないといった場合には、このような簡単な処理でも充分に要求を満たせると思います。ファイルを暗号化する場合には、元のファイル名のままで内容を全て変えてしまいますので、元々のファイルの種類が何だったのかが判り、尚且つそのファイルをそのまま開こうとしても開けないといった状態になります。ファイルを暗号化すると、その時点の日付にファイル日付が変更されますが、復号化(元に戻す)するとファイル日付も元に戻ります。
 コンポーネントではなくてユニットにしたのは、フォームを使用しないプログラムでも簡単に使用出来るようにするためです(自己複合型実行形式ファイルにするということが考えられますね)。
 なお、ファイル入出力部分は強固なエラー処理がなされていません。心配な方は修正して下さい。
 以下をコピーして、ファイル名を'cryptogram.pas'として保存して下さい。
注)バグがあるとファイルが壊れるかもしれないので、最初は大事なファイルで確認することは避けて下さい。

(**
*** 簡易暗号化,複合化ユニット
*** データやファイルそのものを暗号化,複合化する
***
*** ファイルを暗号化する場合には、ファイル先頭にマスクしたパスワードを
*** 保存し、複合化するときにパスワードの照合を行なう
***
*** 簡単な使い方
***  プログラムソースのUses節にcryptogramを加えて、
*** EncryptsFile(FileName, PassWord, False);で暗号化
*** DecryptsFile(FileName, PassWord, False);で復号化
*** します
***
*** 注意
*** 暗号化するファイルが既に暗号化されているかどうかはチェックして
*** いません。逆にこのことを利用して、パスワードを変えて複数回の
*** 暗号化を行なえば、解読が難しくなるかもしれません(そのかわり
*** 元に戻すのが大変ですが)。
***
*** Copyright(c) 2000/8/27 M&I
*** mailto:masahiro.inoue@nifty.ne.jp
*** http://member.nifty.ne.jp/m-and-i/
***
**)

unit  cryptogram;

interface

uses Windows, Sysutils;

(*
  Header
    0 1 234567 89AB 12............43
    $17$00+'LOCKED'+XXXX+'パスワード32文字'
*)

const
  errPWNOMATCH = 1;
  errFILEIO    = 2;

procedure Encrypts(var Buff: PChar; Size: integer; PassWord: string);
procedure Decrypts(var Buff: PChar; Size: integer; PassWord: string);
function GetPassword(Buff: PChar; var FTime: integer): string;
function EncryptsFile(FileName, PassWord: string; OrgFile: Boolean): Boolean;
function DecryptsFile(FileName, PassWord: string; OrgFile: Boolean): integer;

implementation

const
  BuffSize = 1024;

(*
  暗号化
  Buff内のデータをPassWordでXORをかける
*)
procedure Encrypts(var Buff: PChar; Size: integer; PassWord: string);
var
  i, j, PLen, Blk, MLen: integer;
begin
  PLen   := Length(PassWord);
  if PLen = 0 then
    Exit;
  Blk    := Size div PLen;
  MLen   := Size mod PLen;
  for i := 0 to Blk - 1 do
  begin
    for j := 0 to Plen - 1 do
    begin
      Buff[i * PLen + j] := Char(Ord(Buff[i * PLen + j]) xor Ord(PassWord[j + 1]));
    end;
  end;
  if MLen > 0 then
    for i := 0 to MLen - 1 do
      Buff[Blk * PLen + i] := Char(Ord(Buff[Blk * PLen + i]) xor Ord(PassWord[i + 1]));
end;

(*
  復号化
  Buff内のデータをPassWordでXORをかける
  現在の単純な仕様ではExcryptsと全く同じ処理
*)
procedure Decrypts(var Buff: PChar; Size: integer; PassWord: string);
begin
  Encrypts(Buff, Size, PassWord);
end;

(*
  Buff内のデータからPassWordと元ファイルのタイムスタンプを取得
*)
function GetPassword(Buff: PChar; var FTime: integer): string;
var
  i: integer;
  Hd: string;
begin
  Result := '';
  FTime  := 0;
  Hd := Buff[2] + Buff[3] + Buff[4] + Buff[5] + Buff[6] + Buff[7];
  if (Buff[0] = #$17) and (Buff[1] = #$0) and (Hd = 'LOCKED') then
  begin
    for i := 12 to 43 do
    begin
      if Buff[i] = #$0 then
        Break;
      Result := Result + Char(Ord(Buff[i]) xor $DD);
    end;
    FTime := Ord(Buff[8]) + (Ord(Buff[9]) shl 8) + (Ord(Buff[10]) shl 16)
             + (Ord(Buff[11]) shl 24);
  end;
end;

(*
  パスワードと元ファイルのタイムスタンプからヘッダーを作成する
*)
procedure SetPassword(var Buff: PChar; PassWord: string; FTime: integer);
var
  i, PLen: integer;
begin
  Buff[0] := #$17;
  Buff[1] := #$0;
  Buff[2] := 'L';
  Buff[3] := 'O';
  Buff[4] := 'C';
  Buff[5] := 'K';
  Buff[6] := 'E';
  Buff[7] := 'D';
  Buff[8] := Char(FTime and $000F);
  Buff[9] := Char((FTime shr 8) and $000F);
  Buff[10]:= Char((FTime shr 16)and $000F);
  Buff[11]:= Char((FTime shr 24)and $000F);
  for i := 12 to 43 do
    Buff[i] := #0;
  PLen := Length(PassWord);
  if PLen > 32 then
    PLen := 32;
  for i := 0 to PLen - 1 do
    Buff[i + 12] := Char(Ord(PassWord[i + 1]) xor $DD);
end;

(*
  ファイルの暗号化
  FileNameで指定したファイルをPassWordで暗号化する
  OrgFileにTRUEをセットした場合には元ファイルを拡張子を'.ORG'に
  変えて残す
  処理が成功すればTRUEを失敗すればFALSEを返す
*)
function EncryptsFile(FileName, PassWord: string; OrgFile: Boolean): Boolean;
var
  SF, DF, i,
  FSize, Blk,
  MLen,
  FTime: integer;
  Buff: PChar;
  TmpName: string;
begin
  Result := False;
  if Length(PassWord) = 0 then
    Exit;
  {$I-}
  SF := FileOpen(PChar(FileName), fmOpenRead or fmShareDenyNone);
  if SF <= 0 then
    Exit;
  FTime := FileGetDate(SF);
  FSize := FileSeek(SF, 0, 2);
  FileSeek(SF, 0, 0);
  TmpName := ChangeFileExt(FileName, '.$$$');
  DF := FileCreate(PChar(TmpName));
  if DF <= 0 then
  begin
    FileClose(SF);
    Exit;
  end;
  Blk  := FSize div BuffSize;
  Buff := AllocMem(BuffSize);
  try
    SetPassWord(Buff, PassWord, FTime);
    FileWrite(DF, Buff^, 44);
    for i := 0 to Blk - 1 do
    begin
      FileRead(SF, Buff^, BuffSize);
      Encrypts(Buff, BuffSize, PassWord);
      FileWrite(DF, Buff^, BuffSize);
    end;
    MLen := FSize mod BuffSize;
    if MLen > 0 then
    begin
      FileRead(SF, Buff^, MLen);
      Encrypts(Buff, MLen, PassWord);
      FileWrite(DF, Buff^, MLen);
    end;
    FileClose(SF);
    FileClose(DF);
    if OrgFile then
    begin
      if RenameFile(FileName, ChangeFileExt(FileName, '.org')) then
        if RenameFile(TmpName, FileName) then
          Result := True;
    end else begin
      if DeleteFile(FileName) then
        if RenameFile(TmpName, FileName) then
          Result := True;
    end;
  finally
    FreeMem(Buff);
  end;
  {$I+}
end;

(*
  ファイルの復号化
  FileNameで指定したファイルをPassWordで復号化する
  OrgFileにTRUEをセットした場合には元ファイルを拡張子を'.CRP'に
  変えて残す
  処理が成功した場合には0を返す
  パスワードが違う場合にはerrPWNOMATCHをファイル操作に失敗した場合には
  errFILEIOを返す
*)
function DecryptsFile(FileName, PassWord: string; OrgFile: Boolean): integer;
var
  SF, DF, i,
  FSize, Blk,
  MLen,
  FTime: integer;
  Buff: PChar;
  TmpName, PW: string;
begin
  Result := errFILEIO;
  if Length(PassWord) = 0 then
    Exit;
  {$I-}
  SF := FileOpen(PChar(FileName), fmOpenRead or fmShareDenyNone);
  if SF <= 0 then
    Exit;
  FSize := FileSeek(SF, 0, 2);
  if FSize < 35 then
  begin
    FileClose(SF);
    Exit;
  end;
  FileSeek(SF, 0, 0);
  TmpName := ChangeFileExt(FileName, '.$$$');
  DF := FileCreate(PChar(TmpName));
  if DF <= 0 then
  begin
    FileClose(SF);
    Exit;
  end;
  FSize:= FSize - 44;
  Blk  := FSize div BuffSize;
  Buff := AllocMem(BuffSize);
  try
    FileRead(SF, Buff^, 44);
    PW := GetPassWord(Buff, FTime);
    if PassWord <> PW then
    begin
      FileClose(SF);
      FileClose(DF);
      Result := errPWNOMATCH;
      Exit;
    end;
    for i := 0 to Blk - 1 do
    begin
      FileRead(SF, Buff^, BuffSize);
      Decrypts(Buff, BuffSize, PassWord);
      FileWrite(DF, Buff^, BuffSize);
    end;
    MLen := FSize mod BuffSize;
    if MLen > 0 then
    begin
      FileRead(SF, Buff^, MLen);
      Decrypts(Buff, MLen, PassWord);
      FileWrite(DF, Buff^, MLen);
    end;
    if FTime <> 0 then
      FileSetDate(DF, FTime);
    FileClose(SF);
    FileClose(DF);
    if OrgFile then
    begin
      if RenameFile(FileName, ChangeFileExt(FileName, '.crp')) then
        if RenameFile(TmpName, FileName) then
          Result := 0;
    end else begin
      if DeleteFile(FileName) then
        if RenameFile(TmpName, FileName) then
          Result := 0;
    end;
  finally
    FreeMem(Buff);
  end;
  {$I+}
end;

end.

 このユニットの使用は改変や一部流用も含めて自由です。

戻る