寻作者，请高手翻译一下(100分)

  • 主题发起人 huwei1118
  • 开始时间
H

huwei1118

Unregistered / Unconfirmed
GUEST, unregistred user!
这是一个有关控制磁带机读写及备份的单元，没有重要注释，无奈小弟水平有限，寻作者或高手,希望能给解释一下，给出用法及用例，及重要函数的说明。
unit U_TapeManage;

interface

uses
Types, Windows, Classes, SysUtils, ComCtrls, IdGlobal, Forms,
messages;

const
ToltalMsgA = WM_User + 2001;

StepMsgA = WM_User + 2002;
ShowMsgA = WM_User + 2003;




FILE_begin
= 0;
FILE_CURRENT = 1;
FILE_END = 2;


TIME_ZONE_ID_INVALID = $FFFFFFFF;

WAIT_FAILED = $FFFFFFFF;

TAPE_ABSOLUTE_POSITION = $0 ;
TAPE_LOGICAL_POSITION = $1 ;
TAPE_PSEUDO_LOGICAL_POSITION = $2 ;

FILE_FLAG_WRITE_THROUGH = $80000000;

FILE_FLAG_OVERLAPPED = $40000000;

FILE_FLAG_NO_BUFFERING = $20000000;

FILE_FLAG_RANDOM_ACCESS = $10000000;

FILE_FLAG_SEQUENTIAL_SCAN = $08000000;

FILE_FLAG_DELETE_ON_CLOSE = $04000000;

FILE_FLAG_BACKUP_SEMANTICS = $02000000;
FILE_FLAG_POSIX_SEMANTICS = $01000000;

FILE_FLAG_OPEN_REPARSE_POINT = $00200000;

FILE_FLAG_OPEN_NO_RECALL = $00100000;


CREATE_NEW = 1;

CREATE_ALWAYS = 2;

OPEN_EXISTING = 3;

OPEN_ALWAYS = 4;

TRUNCATE_EXISTING = 5;


PROGRESS_CONTINUE = 0;

PROGRESS_CANCEL = 1;

PROGRESS_STOP = 2;

PROGRESS_QUIET = 3;


CALLBACK_CHUNK_FINISHED = $00000000;

CALLBACK_STREAM_SWITCH = $00000001;


//
// Define CopyFileEx option flags
//

COPY_FILE_FAIL_IF_EXISTS = $00000001;

COPY_FILE_RESTARTABLE = $00000002;

COPY_FILE_OPEN_SOURCE_FOR_WRITE = $00000004;



PIPE_ACCESS_INBOUND = $00000001;

PIPE_ACCESS_OUTBOUND = $00000002;

PIPE_ACCESS_DUPLEX = $00000003;


PIPE_CLIENT_END = $00000000;

PIPE_SERVER_END = $00000001;



PIPE_WAIT = $00000000;

PIPE_NOWAIT = $00000001;

PIPE_READMODE_BYTE = $00000000;

PIPE_READMODE_MESSAGE = $00000002;
PIPE_TYPE_BYTE = $00000000;

PIPE_TYPE_MESSAGE = $00000004;



PIPE_UNLIMITED_INSTANCES = 255;

TAPE_INITIATOR_PARTITIONS = $2 ;

TAPE_ERASE_SHORT = $0 ;
TAPE_ERASE_LONG = $1 ;
TAPE_LOAD = $0 ;
TAPE_UNLOAD = $1 ;
TAPE_TENSION = $2 ;
TAPE_LOCK = $3 ;
TAPE_UNLOCK = $4 ;
TAPE_FORMAT = $5 ;

SECURITY_CONTEXT_TRACKING = $00040000;

SECURITY_EFFECTIVE_ONLY = $00080000;


SECURITY_SQOS_PRESENT = $00100000;
SECURITY_VALID_SQOS_FLAGS = $001F0000;


TAPE_REWIND = $0 ;
TAPE_ABSOLUTE_BLOCK = $1 ;
TAPE_LOGICAL_BLOCK = $2 ;
TAPE_PSEUDO_LOGICAL_BLOCK = $3 ;
TAPE_SPACE_END_OF_DATA = $4 ;
TAPE_SPACE_RELATIVE_BLOCKS = $5 ;
TAPE_SPACE_FILEMARKS = $6 ;
TAPE_SPACE_SEQUENTIAL_FMKS = $7 ;
TAPE_SPACE_SETMARKS = $8 ;
TAPE_SPACE_SEQUENTIAL_SMKS = $9 ;


Tape_No_Device = $100;

Tape_Ready = $200;

Tape_Working = $400;

Tape_Read = $800;

Tape_Write = $1000;

type
OVERLAPPED = packed record
Internal: DWORD;

InternalHigh: DWORD;

Offset: DWORD;

OffsetHigh: DWORD;

hEvent: THANDLE;

end;

LPOVERLAPPED = ^OVERLAPPED;


SECURITY_ATTRIBUTES = packed record
nLength: DWORD;

lpSecurityDescriptor: integer;

bInheritHandle: BOOL;

end;


PSECURITY_ATTRIBUTES = ^SECURITY_ATTRIBUTES;

LPSECURITY_ATTRIBUTES = ^SECURITY_ATTRIBUTES;


PROCESS_INFORMATION = packed record
hProcess: THANDLE;

hThread: THANDLE;

dwProcessId: DWORD;

dwThreadId: DWORD;

end;


PPROCESS_INFORMATION = ^PROCESS_INFORMATION;

LPPROCESS_INFORMATION = ^PROCESS_INFORMATION;


FILETIME = packed record
dwLowDateTime: DWORD;

dwHighDateTime: DWORD;

end;


PFILETIME = ^FILETIME;

LPFILETIME = ^FILETIME;


TAPE_SET_POSITION = packed record
Method: DWORD;

Partition: DWORD;

Offset: LARGE_INTEGER;
Immediate: BOOLEAN;

end;


pTAPE_SET_POSITION = ^PTAPE_SET_POSITION;

//
// System time is represented with the following structure:
//

SYSTEMTIME = packed record
wYear: WORD;

wMonth: WORD;
wDayOfWeek: WORD;

wDay: WORD;

wHour: WORD;

wMinute: WORD;

wSecond: WORD;

wMilliseconds: WORD;

end;


PSYSTEMTIME = ^SYSTEMTIME;

LPSYSTEMTIME = ^SYSTEMTIME;


pGET_MEDIA_PARAMETERS = ^GET_MEDIA_PARAMETERS;

GET_MEDIA_PARAMETERS = packed record
Capacity: LARGE_INTEGER;

Remaining: LARGE_INTEGER;

BlockSize: DWORD;

PartitionCount: DWORD;

WriteProtected: BOOLEAN;

end;



GET_DRIVE_PARAMETERS = packed record
ECC: BOOLEAN;

Compression: BOOLEAN;

DataPadding: BOOLEAN;

ReportSetmarks: BOOLEAN;

DefaultBlockSize: DWORD;

MaximumBlockSize: DWORD;

MinimumBlockSize: DWORD;

MaximumPartitionCount: DWORD;

FeaturesLow: DWORD;

FeaturesHigh: DWORD;
EOTWarningZoneSize: DWORD;

end;


pGET_DRIVE_PARAMETERS = ^GET_DRIVE_PARAMETERS;


APEFILEINFO = packed record
FileName: string[116];
//116字节
FileLength: DWORD;
//4字节
StartPosition: int64;
//8字节
WriteTime: TDateTime;

end;


type
TOnChangeFileName = procedure(sFile: string) of object;


TWorkType = (wtNormal, wtWrite, wtRead, wtDoWrite, wtInit);


TManageTheard = class(TThread)
//private
public
FCurFile: string;
FCurIndex: integer;


procedure WriteFile2Tape;

procedure RestoreFile2Disk;

constructor create;

procedure Execute;
override;

end;



TTapeManage = class
//private
public
FTapeTotalContent: Int64;

FileInfo: array[0..999] of APEFILEINFO;


TapeHWND: HWND;


fTapeOpen: boolean;

fTapeLoad: boolean;

fWorking: boolean;

fGetState: boolean;
FIndex: integer;


thMng: TManageTheard;


FWorkType: TWorkType;


FWorkList: array of string;

FWorkCount: integer;
FWorkFile: TStringList;


Mparameters: GET_MEDIA_PARAMETERS;


FMsgHandle: HWND;

FMsgHdle: HWND;

FToltalMsg: UINT;

FStepMsg: UINT;

FShowMsg: UINT;


procedure First;


procedure SetDevicePos(nPos: Int64);


procedure WriteFileA(sFile: string);


procedure GetMadiaparameters;


function initialize: boolean;


procedure WriteTail;

function GetCutrrentUseContent: int64;

procedure GetStateText;

proceduredo
AddFile(fList: TStrings);

procedure InitD;


procedure ShowNoDevice;


constructor create;

destructor destroy;
override;


procedure init;

procedure InitDevice;


function CheckDeviceFreeSize(fList: TStrings): boolean;
procedure AddFile(fList: TStrings);

procedure AppendFile(sFile: string);
procedure GetFileList(bAbsRead: boolean = false);

procedure RestoreFile(sFile: string;
Index: integer);

procedure GetFileList2LV(var fLV: TListView);

procedure RestoreFiles(sPath: string;
IDS: TStrings);


procedure SetProgressMsg(hnd: HWND;
ToltalMsg, StepMsg, ShowMsg: UINT);


property Working: boolean read fWorking write fWorking;

end;



var
TapeMng: TTapeManage;


implementation

//uses U_DefaultValue;

{ TTapeManage }

procedure TTapeManage.AddFile(fList: TStrings);
var
i: integer;

iSize, sCount: int64;

begin

if not fTapeOpen or not fTapeLoad then

ShowNoDevice;
//if fWorking then
exit;

FWorking := true;

FWorkFile.Text := fList.Text;

{GetStateText;
if not CheckDeviceFreeSize(fList) then

begin

Application.MessageBox('磁带机空间不够！'#13'或写保护没有打开！'#13'减少要备份的文件或打开写保护后再试。 ', '系统提示');

FWorking := false;

exit;

end;


FWorkList := nil;

sCount := 0;

FWorkCount := 0;

FIndex := -1;

for i := 0 to 999do

begin

if (FileInfo.FileName = 'END') or (FileInfo.FileLength = 0) then

begin

FIndex := i;

break;

end;


end;



if Findex > -1 then

SetDevicePos(FileInfo[FIndex].StartPosition)
else

begin

First;

Findex := 0;

end;



for i := 0 to fList.Count - 1do

begin

iSize := FileSizeByName(fList.Strings);

if iSize < 1024 then
continue;
//小于1K就不写
inc(sCount, iSize);

inc(FWorkCount);

SetLength(FWorkList, FWorkCount);

FWorkList[FWorkCount - 1] := fList.Strings;

end;


if FToltalMsg <> 0 then

begin

SendMessage(FMsgHdle, FToltalMsg, sCount div 1024, 0);

end;

}
FWorkType := wtDoWrite;
end;


procedure TTapeManage.AppendFile(sFile: string);
var
Index: integer;

iPos: int64;

n: DWORD;

begin

Index := FIndex;
if Index = -1 then
exit;
iPos := FileInfo[Index].StartPosition;
FileInfo[Index].FileName := sFile;
FileInfo[Index].FileLength := FileSizeByName(sFile);
FileInfo[Index].WriteTime := now;
//FileInfo[Index].StartPosition := 500 + iPos + FileInfo[Index].FileLength;

FileInfo[Index + 1].StartPosition := 500 + iPos + FileInfo[Index].FileLength;
FileInfo[Index + 1].FileLength := 0;
FileInfo[Index + 1].FileName := 'END';
n := (FileInfo[Index + 1].StartPosition div 500);
if n * 500 < FileInfo[Index + 1].StartPosition then
Inc(n);
FileInfo[Index + 1].StartPosition := n * 500;
//SetDevicePos(iPos);
n := 0;

if FileInfo[Index].StartPosition = 0 then

n := 10;
WriteFile(TapeHWND, FileInfo[Index], Sizeof(APEFILEINFO), n, nil);
WriteFileA(sFile);
Inc(FIndex);
GetStateText;
//iPos := FileInfo[Index + 1].StartPosition;

//SetDevicePos(iPos);

//n := 0;

//WriteFile(TapeHWND, FileInfo[Index + 1], Sizeof(APEFILEINFO), n, nil);

end;



function TTapeManage.CheckDeviceFreeSize(fList: TStrings): boolean;

var
i: integer;

iLen, iSize: int64;

begin

Result := false;

iLen := 0;

for i := 0 to fList.Count - 1do

begin

iSize := FileSizeByName(fList.Strings);

//if iSize &amp;lt;
1024 then
Continue;

inc(iLen, iSize);

end;


for i := 0 to 999do

begin

if FileInfo.FileLength > 0 then

Inc(iLen, FileInfo.FileLength)
else

break;

end;


i := 0;

while i < 10do

begin

if FTapeTotalContent = 0 then

GetMadiaparameters
else
break;

inc(i);

end;


if FTapeTotalContent < iLen then
exit;

if Mparameters.WriteProtected then
exit;


Result := true;

end;



constructor TTapeManage.create;

begin

FWorkFile := TStringList.Create;

fGetState := false;

fTapeOpen := false;

fTapeLoad := false;

FMsgHandle := 0;

FMsgHdle := 0;

FToltalMsg := 0;

FStepMsg := 0;

FShowMsg := 0;

FTapeTotalContent := 0;

fWorking := false;

FillChar(FileInfo, Sizeof(FileInfo), 0);

TapeHWND := CreateFile('//./TAPE0', GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ +
FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

fTapeOpen := TapeHWND <> INVALID_HANDLE_VALUE;
end;



destructor TTapeManage.destroy;

begin

thMng.Terminate;

Closehandle(TapeHWND);

FWorkFile.Free;

inherited;

end;



procedure TTapeManage.DoAddFile(fList: TStrings);

var
i: integer;

iSize, sCount: int64;

begin

if fWorking then
exit;

FWorking := true;

GetStateText;

{if not CheckDeviceFreeSize(fList) then

begin

Application.MessageBox('磁带机空间不够！'#13'或写保护没有打开！'#13'减少要备份的文件或打开写保护后再试。 ', '系统提示');

FWorking := false;

exit;

end;

}
if not CheckDeviceFreeSize(fList) then

begin

Application.MessageBox('The space available on tape is not enough!'#13'or writting is locked!'#13'Please reduce the size of file(s) to be backed up or unlock for writting! ', 'Caution');

FWorking := false;

exit;

end;


FWorkList := nil;

sCount := 0;

FWorkCount := 0;

FIndex := -1;

FileInfo[0].StartPosition := 0;

for i := 0 to 999do

begin

if (FileInfo.FileName = 'END') or (FileInfo.FileLength = 0) then

begin

FIndex := i;

break;

end;


end;



if Findex > -1 then

SetDevicePos(FileInfo[FIndex].StartPosition)
else

begin

First;

Findex := 0;

end;



for i := 0 to fList.Count - 1do

begin

iSize := FileSizeByName(fList.Strings);

if iSize < 1024 then
continue;
//小于1K就不写
inc(sCount, iSize);

inc(FWorkCount);

SetLength(FWorkList, FWorkCount);

FWorkList[FWorkCount - 1] := fList.Strings;

end;


//if FToltalMsg &amp;lt;&amp;gt;
0 then

//begin

SendMessage(FMsgHdle, ToltalMsgA, sCount div 1024, 0);

//end;


FWorkType := wtWrite;

end;



procedure TTapeManage.First;

begin

SetTapePosition(TapeHWND, TAPE_ABSOLUTE_BLOCK, 0, 0, 0, FALSE);

end;



function TTapeManage.GetCutrrentUseContent: int64;

var
i: integer;

begin

Result := 0;

for i := 0 to 999do

begin

if FileInfo.FileLength = 0 then
exit;

inc(Result, FileInfo.FileLength);

end;


end;



procedure TTapeManage.GetFileList(bAbsRead: boolean);

var
iCount, i: integer;

cRead: DWord;

iPos: int64;

begin

iCount := 0;

for i := 0 to 999do

if FileInfo.FileLength > 0 then

inc(iCount)
else

break;

if not bAbsRead and (iCount > 0) then

exit;

First;

iCount := 0;

while truedo

begin

cRead := 0;

ReadFile(TapeHWND, FileInfo[iCount], Sizeof(APEFILEINFO), cRead, nil);

if (cRead = 0) or ((FileInfo[iCount].FileName = 'END') and (FileInfo[iCount].FileLength = 0)) then

begin

cRead := GetLastError;

if cRead = ERROR_NO_DATA_DETECTED then

begin

FileInfo[iCount - 1].FileLength := 0;

FileInfo[iCount - 1].FileName := 'END';

end;


break;

end;


iPos := FileInfo[iCount].StartPosition + FileInfo[iCount].FileLength + 500;

inc(iCount);

SetDevicePos(iPos);

end;



if iCount = 0 then

InitDevice
else

FileInfo[iCount].StartPosition := FileInfo[iCount - 1].StartPosition + FileInfo[iCount - 1].FileLength + 500
end;



procedure TTapeManage.GetFileList2LV(var fLV: TListView);

var
i: integer;

cItem: TListItem;

begin

fLV.Clear;

for i := 0 to 999do

begin

if FileInfo.FileLength = 0 then
exit;

cItem := fLV.Items.Add;

cItem.Caption := ExtractFileName(FileInfo.FileName);

cItem.SubItems.Add(format('%.0n', [round(FileInfo.FileLength / 1024) * 1.0]));

cItem.SubItems.Add(FormatDateTime('yyyy-mm-dd hh:nn:ss', FileInfo.WriteTime));

end;


end;



procedure TTapeManage.GetMadiaparameters;

var
i: integer;

BlockSize: Cardinal;

begin

if fGetState then
exit;

fGetState := true;

BlockSize := 0;

i := 12;

while i <> NO_ERRORdo

begin

i := GetTapeParameters(TapeHWND, GET_TAPE_MEDIA_INFORMATION, BlockSize, @Mparameters);

inc(BlockSize);

if BlockSize > 1000 then

exit;

end;


FTapeTotalContent := Mparameters.Capacity.QuadPart;

fGetState := false;

end;



procedure TTapeManage.GetStateText;

var
i: int64;

i1: integer;

ss: string;

begin

ss := '';

i := 0;

if not fTapeOpen then
i := Tape_No_Device;

if fTapeLoad then
i := i or Tape_Ready or Tape_Read;

if fWorking then
i := i or Tape_Working;

i1 := 0;

while i1 < 10do

begin

if FTapeTotalContent = 0 then

GetMadiaparameters
else
break;

inc(i1);

end;


if not Mparameters.WriteProtected and fTapeLoad then
i := i or Tape_Write;

ss := Inttostr(i) + '^' + Inttostr(GetCutrrentUseContent) + '^' + inttostr(FTapeTotalContent);

//if FShowMsg &amp;lt;&amp;gt;
0 then

SendMessage(FMsgHdle, ShowMsgA, integer(pInteger(pChar(ss))), -1);

end;



procedure TTapeManage.init;

begin

thMng := TManageTheard.create;

end;



procedure TTapeManage.InitD;

var
n: DWORD;

begin

FillChar(FileInfo, Sizeof(FileInfo), 0);

FileInfo[0].StartPosition := 0;

FileInfo[0].FileName := 'END';


CreateTapePartition(TapeHWND, TAPE_INITIATOR_PARTITIONS, 1, 500);

WriteFile(TapeHWND, FileInfo[0], Sizeof(APEFILEINFO), n, nil);

fWorking := false;


GetStateText;

end;



procedure TTapeManage.InitDevice;

begin

if not fTapeOpen or not fTapeLoad then

ShowNoDevice;

fWorking := true;

GetStateText;

FWorkType := wtInit;

end;


function TTapeManage.initialize: boolean;
var
i: integer;

begin

Result := false;

i := 0;

//fGetState := true;

while truedo

begin

if PrepareTape(TapeHWND, TAPE_LOAD, false) = NOERROR then
break;
inc(i);
if i > 10 then
exit;
end;


fGetState := false;


fTapeLoad := true;


GetMadiaparameters;


GetFileList(true);


Result := true;

end;



procedure TTapeManage.RestoreFile(sFile: string;
Index: integer);
var
rFile, rLen: integer;

iPos, iLen: int64;

cBuf: array[0..499] of byte;
rRead: DWORD;

sMsg: string;
begin

//如果还原空间不够的话，需要提示
{if DiskFree(ord(sFile[1]) - 64) &amp;lt;
FileInfo[Index].FileLength then

begin

application.MessageBox('还原空间不够！'#13'请清除数据或更换还原空间后再试！', '系统提示');
exit;
end;

}
if DiskFree(ord(sFile[1]) - 64) < FileInfo[Index].FileLength then

begin

application.MessageBox('The space for restoring is not enough!'#13'Please delete some files in destination or redirect to another destination!', 'Caution');
exit;

end;

//iPos := FileInfo[Index].StartPosition + 500;

IPos := 0;
SetDevicePos(iPos);

//if FShowMsg &amp;lt;&amp;gt;
0 then

//begin

sMsg := ExtractFileName(FileInfo[Index].FileName) + ' ----&amp;gt;
' + sFile;
SendMessage(FMsgHdle, ShowMsgA, integer(pInteger(pChar(sMsg))), 0);
//end;


//if FStepMsg &amp;lt;&amp;gt;
0 then

SendMessage(FMsgHdle, StepMsgA, FileInfo[Index].FileLength, 0);

rFile := FileCreate(sFile);
iLen := 0;
rLen := 500;
while iLen < FileInfo[Index].FileLengthdo

begin


if rLen + iLen > FileInfo[Index].FileLength then

rLen := FileInfo[Index].FileLength - iLen;
rRead := 0;




if not ReadFile(TapeHWND, cBuf[0], rLen, rRead, nil) then

begin

rRead := GetLastError;
if rRead <> 0 then
break;
end;

FileWrite(rFile, cBuf[0], rRead);
inc(iLen, rRead);
//if FStepMsg &amp;lt;&amp;gt;
0 then

PostMessage(FMsgHdle, StepMsgA, FileInfo[Index].FileLength, iLen);
//if FToltalMsg &amp;lt;&amp;gt;
0 then

PostMessage(FMsgHdle, ToltalMsgA, -1, rRead);
end;



FileClose(rFile);
//if FStepMsg &amp;lt;&amp;gt;
0 then

SendMessage(FMsgHdle, StepMsgA, FileInfo[Index].FileLength, FileInfo[Index].FileLength);

GetStateText;

end;


procedure TTapeManage.RestoreFiles(sPath: string;
IDS: TStrings);
var
i: integer;

sCount: int64;

begin

if not fTapeOpen or not fTapeLoad then

ShowNoDevice;

if fWorking then
exit;

fWorking := true;
GetStateText;
FWorkCount := IDS.Count;
SetLength(FWorkList, FWorkCount);

sCount := 0;

for i := 0 to FWorkCount - 1do

begin

FWorkList := sPath + '^' + IDS.Strings;

Inc(sCount, FileInfo[strtoint(IDS.Strings)].FileLength);
end;


//if FToltalMsg &amp;lt;&amp;gt;
0 then

SendMessage(FMsgHdle, ToltalMsgA, sCount div 1024, 0);

FWorkType := wtRead;

end;



procedure TTapeManage.SetDevicePos(nPos: Int64);
var
nLow, nhigh, TapeStatus: Cardinal;

cPos: int64;

begin

cPos := round(nPos / 500);

if cPos * 500 < nPos then
inc(cPos);
nLow := cPos and $FFFFFFFF;
nHigh := cPos shr 32 and $FFFFFFFF;

TapeStatus := SetTapePosition(TapeHWND, TAPE_ABSOLUTE_BLOCK, 0, nLow, nhigh, FALSE);
if TapeStatus <> NOERROR then

begin

//显示一个信息
//Application.MessageBox('定位到磁带机不成功！', pchar(MSG_TITLE));
//Abort;

end;


end;



procedure TTapeManage.SetProgressMsg(hnd: HWND;
ToltalMsg, StepMsg,
ShowMsg: UINT);
begin

FMsgHandle := hnd;

FMsgHdle := hnd;

FToltalMsg := ToltalMsg;

FStepMsg := StepMsg;

FShowMsg := ShowMsg;

//GetStateText;
end;



procedure TTapeManage.ShowNoDevice;

begin

application.MessageBox('No Tape or Tape can''t used!'#13'Please Check it and try agin.', 'sdfs'{pchar(MSG_TITLE)});
abort;

end;



procedure TTapeManage.WriteFileA(sFile: string);
var
cBuf: array[0..499] of byte;

fSize, wPos: int64;

wLen, wFile: integer;

n: Dword;

sMsg: string;

begin

//if FShowMsg &amp;lt;&amp;gt;
0 then

//begin

sMsg := sFile;

SendMessage(FMsgHdle, ShowMsgA, integer(pinteger(pChar(sMsg))), 0);

//end;


fSize := FileSizeByName(sFile);

//if FStepMsg &amp;lt;&amp;gt;
0 then

SendMessage(FMsgHdle, StepMsgA, fSize, 0);

wFile := FileOpen(sFile, fmOpenRead or fmShareDenyNone);

wPos := 0;

while wPos < fSizedo

begin

wLen := 500;

if wLen + wPos > fSize then

wLen := fSize - wPos;

Fileread(wFile, cBuf[0], wLen);
WriteFile(TapeHWND, cBuf[0], wLen, n, nil);

inc(wPos, wLen);

//if FStepMsg &amp;lt;&amp;gt;
0 then

PostMessage(FMsgHdle, StepMsgA, fSize, wPos);

//if FToltalMsg &amp;lt;&amp;gt;
0 then

PostMessage(FMsgHdle, ToltalMsgA, -1, wLen);

end;


FileClose(wFile);

//if FStepMsg &amp;lt;&amp;gt;
0 then

SendMessage(FMsgHdle, StepMsgA, fSize, fSize);

end;



procedure TTapeManage.WriteTail;

var
n: DWORD;

begin

n := 0;

WriteFile(TapeHWND, FileInfo[FIndex], Sizeof(APEFILEINFO), n, nil);

end;



{ TManageTheard }

constructor TManageTheard.create;

begin

inherited Create(false);
FreeOnTerminate := true;
end;


procedure TManageTheard.Execute;

var
i: integer;

begin

{ TapeMng.Working := true;
TapeMng.initialize;

TapeMng.Working := false;

TapeMng.GetStateText;

while not Terminateddo

begin

if not TapeMng.Working then

TapeMng.FWorkType := wtNormal;

case TapeMng.FWorkType of
wtNormal:
begin

sleep(20);

continue;

end;


wtWrite, wtRead:
begin

for i := 0 to TapeMng.FWorkCount - 1do

begin

if Terminated then
exit;

FCurIndex := i + 1;

FCurFile := TapeMng.FWorkList;

if TapeMng.FWorkType = wtWrite then

WriteFile2Tape
else

RestoreFile2Disk;

sleep(10);

end;


if TapeMng.FWorkType = wtWrite then

TapeMng.WriteTail;

//if TapeMng.FToltalMsg &amp;lt;&amp;gt;
0 then

SendMessage(TapeMng.FMsgHdle, ToltalMsgA, -1, -1);

TapeMng.FWorkType := wtNormal;

TapeMng.fWorking := false;

TapeMng.GetStateText;

end;


wtDoWrite:
begin

TapeMng.FWorkType := wtNormal;

TapeMng.fWorking := false;

TapeMng.DoAddFile(TapeMng.FWorkFile);

end;


wtInit:
begin

TapeMng.InitD;

TapeMng.FWorkType := wtNormal;

TapeMng.fWorking := false;

end;


end;


end;

}
end;



procedure TManageTheard.RestoreFile2Disk;
var
sFile: string;
Index: integer;

begin

sFile := Copy(FCurFile, 1, Pos('^', FCurFile) - 1);

delete(FCurFile, 1, Pos('^', FCurFile));
Index := StrToInt(FCurFile);

sFile := sFile + 'Restore_' + ExtractFileName(TapeMng.FileInfo[Index].FileName);

TapeMng.RestoreFile(sFile, Index);

end;



procedure TManageTheard.WriteFile2Tape;

begin

TapeMng.AppendFile(FCurFile);

end;



end.
 
自己解决了[:D]
 
多人接受答案了。
 
您必须登录或注册才可回复。

Similar threads

I
一个IE工具单元
回复
0
查看
773
import
I
I
获取文件版本信息
回复
0
查看
1K
import
I
I
一个函数集
回复
0
查看
638
import
I
I
自定义文件数据结构的一个支持单元
回复
0
查看
1K
import
I
I
FTP 使用 WININET
回复
0
查看
670
import
I
顶部