// クリップボードへのテキストコピーです
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;
>>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.
>>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;