DELPHI和BCB雙修的先進們救救小弟啊

發表時間：2008-03-28 08:57:39

IP:222.135.xxx.xxx 訂閱

DELPHI和BCB雙修的先進們，誰能幫小弟把下面DELPHI的代碼轉成BCB的，老闆說了，如果本周不能搞定的話就炒了，小弟現在這個工作趕著很順心不想離開，哪位先進會的幫忙轉一下，感恩！將SPL類型轉換為EMF檔
[code delphi]

function SPLToEMF(): Boolean;stdcall;export;//將SPL類型轉換為EMF檔
var
reg : TRegistry;
SearchRes : TSearchRec;// 查找檔的結構
nGaugeCounter, // makes nice gauge
nFound, i : Integer; // # of files found (when searching)
strTemp : string[8]; // filename: .emf
strCnt : string; //

strSpoolDir : string; // spool-directory (NT only)
strOldFile, strNewFile : string; // filename (NT: spool file)
m_strTempVar : string; // registry entry holding destination dir for print jobs
strDestDir : string; // 保存EMF檔的路徑
strSHDFile : string; // instruction file
lpszTempDir : PChar; // %TEMP%的路徑名稱(僅用於95 or NT)%TEMP% dir (w95 & nt)
lpszSpoolDir : PChar; // 列印處理器的路徑名稱(僅用於NT or 2K)spool dir (nt only)
IsEnd:Boolean;
label Res; // 定義返回的goto變數

begin
IsEnd:=false;
nGaugeCounter := 0;
//初始化lpszTempDir和lpszSpoolDir
GetMem(lpszTempDir, 255);
GetMem(lpszSpoolDir, 255);
if (GetEnvironmentVariable('temp', lpszTempDir, 255) = 0) then
begin
MsgError('Environment Variable %temp% not set!' #13
'Either install driver properly or' #13 'define a %temp% environment variable.');
FreeMem(lpszTempDir);
goto Res;
end;
strTempDir := string(lpszTempDir);
FreeMem(lpszTempDir);
//從註冊表中得到EMF檔的目的路徑
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
if reg.OpenKey(PMON_KEY,TRUE) then
begin
m_strTempVar := reg.ReadString('Temp');
end;
reg.CloseKey;
reg.Free;
if (m_strTempVar = '') then
begin
strTempDir:='C:\TEMP';
MsgError('您的列印目的沒有選擇,檔將保存在C:\TEMP下');
end
else
begin
strTempDir := m_strTempVar;
end;
if (strTempDir[Length(strTempDir)] <> '\') then
begin
strTempDir := Concat(strTempDir, '\');
end;
nFileCounter := 1;
//得到系統版本
strOSVer := GetOSName;
//根據版本處理
{對於NT 和其高版本的作業系統}
if (strOSVer = 'Windows NT') or (strOSVer = 'Windows 2000') or (strOSVer = 'Windows XP') then
begin
//得到spool的路徑
GetEnvironmentVariable('windir', lpszSpoolDir, 255);
strSpoolDir := string(lpszSpoolDir) '\system32\spool\PRINTERS\';
FreeMem(lpszSpoolDir);
end;
//在暫存檔案夾中刪除舊的emf檔和spl檔
nFound := FindFirst(strTempDir '*.emf', faAnyFile, SearchRes);
while nFound = 0 do
begin
DeleteFile(PChar(strTempDir SearchRes.Name));
nFound := FindNext(SearchRes);
end;
FindClose(SearchRes);
{對於NT以下的作業系統}
if (strOSVer = 'Windows 95') or (strOSVer = 'Windows98') or (strOSVer = 'Windows 98SE') or (strOSVer = 'Windows ME') then
begin
MsgError('此虛擬列印暫時不支援低版本系統。');
end
else
begin
StringList := TStringList.Create;
//在印表機的暫存檔案夾中查找暫存檔案
nFound := FindFirst(strSpoolDir '*.SPL', faAnyFile, SearchRes);
while nFound = 0 do
begin
Inc(nGaugeCounter);
nFound := FindNext(SearchRes);
end;
FindClose(SearchRes);
nFileCounter := 0;
nFound := FindFirst(strSpoolDir '*.SPL', faAnyFile, SearchRes);
if nFound = 0 then
begin
{$I-}
DateSeparator := '-';
TimeSeparator := '-';
//重新編寫EMF的目的路徑
strDestDir := strTempDir;//strDestDir是保存EMF檔的路徑
//創建文件夾
if IOResult <> 0 then
begin
raise Exception.Create('不能創建檔夾 ' strDestDir ': ' IntToStr(IOResult))//strDestDir是保存EMF檔的路徑
end;
end;
while nFound = 0 do
begin
strOldFile := strSpoolDir SearchRes.Name;
strSHDFile := StringReplace(strOldFile, '.SPL', '.SHD', [rfIgnoreCase]);
strNewFile := strDestDir '\' SearchRes.Name;//strDestDir是保存EMF檔的路徑
StringList.Add(strNewFile);
if not FileExists(strOldFile) then
begin
raise Exception.Create('SPOOL檔沒有找到: ' strOldFile)
end
else
begin
if not CopyFile(PChar(strOldFile), PChar(strNewFile), False) then
begin
raise Exception.Create('不能拷貝檔: ' strOldFile);
end;
end;
nFound := FindNext(SearchRes);
Inc(nFileCounter);
strCnt := '';
strTemp := '';
end;
FindClose(SearchRes);
for i:=0 to nFileCounter-1 do
begin
ReadBinaryDataFile(StringList.Strings[i], strDestDir '\');//strDestDir是保存EMF檔的路徑
end;
end;
nFound := FindFirst(strSpoolDir '*.spl', faAnyFile, SearchRes);
while nFound = 0 do
begin
DeleteFile(PChar(strSpoolDir SearchRes.Name));
nFound := FindNext(SearchRes);
end;
FindClose(SearchRes);
nFound := FindFirst(strSpoolDir '*.shd', faAnyFile, SearchRes);
while nFound = 0 do
begin
DeleteFile(PChar(strSpoolDir SearchRes.Name));
nFound := FindNext(SearchRes);
end;
FindClose(SearchRes);
IsEnd:=true;
Res:
Result:=IsEnd;
end;
上面的函數中使用到的一些結構EMFheader結構如下定義
type EMFheader = record
Signature: Integer;
EMFsize: Integer;
end;
const EMFheaderSignature = $0C;
使用到的ReadBinaryDataFile函數如下實現。
//讀出一個NT下的 *.spl檔並將其轉換為一個*.EMF文件
//參數說明 strFilename:*.spl檔的檔案名稱 strDestDir需要轉換成為*.emf檔的檔案名稱
procedure ReadBinaryDataFile(strFilename : string; strDestDir : string);
var
fFromF, fToF : file; //定義輸入和輸出檔
strEMFFileName, strTmp : string;
nRead, nWritten, i, nReadTotal, nNextFilePos : Integer;
Buf : array[1..2048] of Char; //定義一個讀取EMF檔的buffer
nPixFound, test : Integer;
PosList : TStringList;
strHeaderBytes : string; //從函數fDetectHeaderBytes讀出的6位元組長的emf檔頭
begin
if not FileExists(strFileName) then
begin
raise Exception.Create('不能讀檔: ' strFileName)
end
else
begin
strHeaderBytes := fDetectHeaderBytes(strFileName);
AssignFile(fFromF, strFileName);
end;
Reset(fFromF, 1);
PosList := TStringList.Create;
nPixFound := 0;
nReadTotal := 0;
repeat
//注意strHeaderBytes的含義
BlockRead(fFromF, Buf, SizeOf(Buf), nRead);
test := Pos(strHeaderBytes, Buf);
if (test > 0) then
begin
Inc(nPixFound);
if test<>0 then PosList.Add(IntToStr(test nReadTotal));
end;
Inc(nReadTotal, nRead);
until (nRead = 0) ;
for i:=1 to nPixFound do
begin
strTmp := IntToStr(i);
while Length(strTmp)< 8 do
begin
Insert('0', strTmp, 1);
end;
strEMFFileName := Concat(strDestDir, strTmp,'.EMF');//strDestDir是需要轉換成EMF檔的檔案名稱
AssignFile(fToF, strEMFFileName);
Rewrite(fToF, 1);
try
Seek(fFromf, StrToInt(PosList.Strings[i-1])-1);
repeat
BlockRead(fFromF, Buf, SizeOf(Buf), nRead);
BlockWrite(fToF, Buf, nRead, nWritten);
if i nNextFilePos := StrToInt(PosList.Strings[i])
else
nNextFilePos := FileSize(fFromF);
until (FilePos(fFromF)>=nNextFilePos);
except
on EInOutError do MsgError('讀檔錯誤');
end;
CloseFile(fToF);
end;
CloseFile(fFromF);
PosList.Free;
DeleteFile(strFilename);
end;

[/code]