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

このエントリーをはてなブックマークに追加
1661
// クリップボードへのテキストコピーです

procedure toClip(const s:string);
var size:Integer;
var dh: THandle;
var dt:PChar;
begin
size:=Length(s)+1;
    EmptyClipboard;
   OpenClipBoard(0);
 try
  dh := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, size);
  try
   dt := GlobalLock(dh);
   try
    Move(PChar(s)^, dt^, size);
    SetClipboardData(CF_TEXT, dh);
   finally
    GlobalUnlock(dh);
   end;
  except
   GlobalFree(dh); //エラー時のみ
  end;
 finally CloseClipboard; end;
end;
1671:02/06/27 16:44
>>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.
1681:02/06/27 16:49
>>167 を ファイル名を引数にして実行すると
例 Bin2Byte Bin2Byte.exe

実行結果

const =Bin2Byte_exe:array[0..43519]=
($4D,$5A,$50,$00,$02,$00,$00,$00,$04,$00,$0F,$00,$FF,$FF,$00,$00
,$B8,$00,$00,$00,$00,$00,$00,$00,$40,$00,$1A,$00,$00,$00,$00,$00
 ・・・・ 略・・・・
);

 というようなのがクリップボードに入ります。
 これを使えばバイナリファイルをリソースではなく直接ソースに埋め込めます

取り出す時のコードは

function writeFileBin(fname:string;data:array of byte):boolean;
var hout:THandle;
var wsize:DWORD;
begin
result:=false;
 hout:=CreateFile(PChar(fname),GENERIC_WRITE,0,nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0);
if hout<>0 then try
  if WriteFile(hout,data,Length(data),wsize,nil) then
   result:=wsize=DWORD(Length(data));
 finally CloseHandle(hout);
 end
end;