Delphiで小さな実行ファイルを作ろう

このエントリーをはてなブックマークに追加
1671
>>166  EmptyClipboard; と OpenClipBoard(0);  の順番が逆でした
これを使ってこんなのを作ってみました。
program Bin2Byte;
uses Windows,SysUtils;
// >>166の修正してコピペ
function readFileStr(fname:string):string;
var hin:THandle;
var rsize:DWORD;
begin
result:='';
hin:=CreateFile(PChar(fname),GENERIC_READ,FILE_SHARE_READ ,nil,OPEN_EXISTING
,FILE_ATTRIBUTE_NORMAL,0);
if hin<>0 then try
SetLength(Result, GetFileSize(hin, nil));
 ReadFile(hin,PChar(Result)^,Length(Result),rsize , nil);
finally CloseHandle(hin);
end
end;
function getWin32Find(const fname:string):TWin32FindData;
var h:THandle;
begin
  h:=FindFirstFile(PChar(fname),Result);
  if h = INVALID_HANDLE_VALUE then begin
   Result.cFileName[0]:=#0;
  end else Windows.FindClose(h);
end;
var buf,s,c0,wk,fname:string;
var i,n,siz,bufc:Integer;
procedure puts(s:string);
var i:Integer;
begin
 for i:=1 to Length(s) do begin buf[bufc+1]:=s[i];inc(bufc);end;
end;
begin
 if ParamCount<1 then exit;
 fname:=ParamStr(1);
 with getWin32Find(fname) do begin
 if cFileName='' then exit;
  s:=cFileName;
  end;
  for i:=1 to Length(s) do if s[i]='.' then s[i]:='_';
  bufc:=0;
  wk:=readFileStr(fname);
  siz:=Length(wk);
 SetLength(buf,siz*4+(siz div 4)+length(s)+1000);
 puts('const '); puts(s);puts(':array[0..'+IntToStr(siz-1)+'] of byte='#13#10);
  n:=0;
  c0:='($';
  while n<siz do begin
  for i:=0 to 15 do if(n<siz) then
   begin puts(c0+IntToHex(ord(wk[n+1]),2));inc(n);c0:=',$';end;
   puts(#13#10);
  end;
  puts(');'#13#10);
  SetLength(buf,bufc);
  toClip(buf);
end.