BSOne.SFC/Tocsg.Lib/VCL/CS/Tocsg.StoredPacket.pas

1195 lines
31 KiB
Plaintext

{*******************************************************}
{ }
{ Tocsg.StoredPacket }
{ }
{ Copyright (C) 2022 sunk }
{ }
{*******************************************************}
unit Tocsg.StoredPacket;
interface
uses
SysUtils, Classes, SyncObjs, Tocsg.Encrypt, Tocsg.Obj, Tocsg.Packet,
Winapi.Windows, Tocsg.Exception, System.Generics.Collections;
const
SIGN_KKU48 = $9748;
VER_SOTRED = 'StdPkt-v1.2';
MAX_DATA_SIZE = 2147483648;//2 * 1024 * 1024 * 1024;
PASS_ENC = 'QT8$4oci2!.QpdlQzd23ds9';
TASK_UNKNOWN = $00;
TASK_SAVE = $01;
TASK_LOAD = $02;
TASK_DESTROY = $03;
TASK_SAVE_FULL = $04;
type
THeaderStored = packed record
sVer : array [0..19] of AnsiChar;
llMaxSize,
llTotalEntry,
llProcssOffset : LONGLONG;
dwTaskType : DWORD;
wEncType : WORD;
ucReserve : array [0..459] of Byte;
wSign : WORD;
end;
const
OFFSET_MAX_SIZE = 20;
OFFSET_TOTAL_ENTRY = OFFSET_MAX_SIZE + SizeOf(LONGLONG);
OFFSET_PROC_OFFSET = OFFSET_TOTAL_ENTRY + SizeOf(LONGLONG);
OFFSET_TASK_TYPE = OFFSET_PROC_OFFSET + SizeOf(LONGLONG);
type
ECrmStoredPacket = class(ETgException);
TStdPacketBase = class(TTgObject)
private
sFName_: String;
protected
Enc_: TTgEncrypt;
fs_: TFileStream;
Header_: THeaderStored;
procedure LoadStoredHeader;
procedure SetTaskType(dwTaskType: DWORD);
function GetTaskType: DWORD;
function GetStoredSize: LONGLONG;
function GetEntryCount: LONGLONG;
procedure IncEntry;
procedure DecEntry;
function GetRemainSize: LONGLONG;
function GetFileSize: LONGLONG;
public
Constructor Create(const sFileName: String);
Destructor Destroy; override;
property FileName: String read sFName_;
property FileSize: LONGLONG read GetFileSize;
property TaskType: DWORD read GetTaskType write SetTaskType;
property StoredSize: LONGLONG read GetStoredSize;
property TotalEntry: LONGLONG read GetEntryCount;
property LastError: Integer read nLastError_;
end;
ESavePacekt = class(ECrmStoredPacket);
TSavePacket = class(TStdPacketBase)
protected
procedure InitStoredHeader(llMaxSize: LONGLONG; dwTaskType: DWORD; aEncKind: TTgEncKind; wSign: WORD);
public
Constructor Create(const sFileName: String; llMaxSize: LONGLONG = MAX_DATA_SIZE;
EncAlgorithm: TTgEncKind = ekNone; bSaveFileHideSystem: Boolean = false);
procedure PushPacketBuf(aBuf: TBytes); overload; virtual;
procedure PushPacketBuf(aBuf: Pointer; nLen: Integer); overload; virtual;
end;
TLoadPacket = class(TStdPacketBase)
public
Constructor Create(const sFileName: String; bInitLoad: Boolean = true);
procedure InitLoadHeader;
function PopPacketBuf: TBytes; virtual;
property RemainSize: LONGLONG read GetRemainSize;
end;
TTgStoredPacket = class(TTgObject)
private
sFNameH_,
sSaveFN_,
sLoadFN_: String;
SavePacket_: TSavePacket;
LoadPacket_: TLoadPacket;
bBlockMaxSize_: Boolean; // 최대 크기 이후 저장 하지 않음
ullMaxSize_, // 최대 저장 크기 추가
ullSegmentSize_: ULONGLONG;
EncAlgorithm_: TTgEncKind;
bSaveFileHideSystem_: Boolean; // 파일 저장 시 숨김, 시스템 속성 추가 22_0124 14:58:09 sunk
function _CreateStoredSave: TSavePacket;
function _CreateStoredLoad: TLoadPacket;
procedure SetSavePacketTaskType(dwTaskType: DWORD);
procedure SetMaxSize(ullMaxSize: ULONGLONG);
procedure SetSegmentSize(ullSegmentSize: ULONGLONG);
function GetStoredSavePath: String;
function GetStoredLoadPath: String;
public
Constructor Create(const sSaveFN: String; EncAlgorithm: TTgEncKind = ekNone);
Destructor Destroy; override;
procedure PushPacket(aPacket: ITgPacket); overload;
procedure PushPacket(pPktBuf: TBytes); overload;
procedure PushPacket(pPktBuf: Pointer; nLen: Integer); overload;
procedure PushPacket(sPacket: UTF8String); overload;
function PopPacketStr: String;
function PopPacket: ITgPacket;
function GetFirstStoredPath: String;
procedure SafeFreeSaveStored(const sPath: String; dwTaskType: DWORD);
property MaxSize: ULONGLONG read ullMaxSize_ write SetMaxSize;
property SegSize: ULONGLONG read ullSegmentSize_ write SetSegmentSize;
property SavePacketTaskType: DWORD write SetSavePacketTaskType;
property StoredSavePath: String read GetStoredSavePath;
property StoredLoadPath: String read GetStoredLoadPath;
property SaveFileAttrHideSystem: Boolean write bSaveFileHideSystem_;
property IsBlockMaxSize: Boolean write bBlockMaxSize_;
end;
// 미러링 기능 추가 때문에 작성
PSpmEnt = ^TSpmEnt;
TSpmEnt = record
sSaveFN: String;
SavePacket: TSavePacket;
end;
TSpmEntList = TList<PSpmEnt>;
TTgStoredPacketMirror = class(TTgObject)
private
SpmEntList_: TSpmEntList;
ullSegmentSize_: ULONGLONG;
EncAlgorithm_: TTgEncKind;
bSaveFileHideSystem_: Boolean; // 파일 저장 시 숨김, 시스템 속성 추가
procedure OnSpmEntNotify(Sender: TObject; const Item: PSpmEnt; Action: TCollectionNotification);
function _CreateStoredSave(sSaveFN: String): TSavePacket;
procedure SetSegmentSize(ullSegmentSize: ULONGLONG);
function GetSegmentSize: ULONGLONG;
public
Constructor Create(sPaths, sFName: String; EncAlgorithm: TTgEncKind = ekNone);
Destructor Destroy; override;
procedure PushPacket(aPacket: ITgPacket); overload;
procedure PushPacket(pPktBuf: TBytes); overload;
procedure PushPacket(pPktBuf: Pointer; nLen: Integer); overload;
property SegmentSize: ULONGLONG read GetSegmentSize write SetSegmentSize;
property SaveFileAttrHideSystem: Boolean write bSaveFileHideSystem_;
end;
implementation
uses
Tocsg.Safe, Tocsg.Strings, Tocsg.Files, System.Math;
{ TStdPacketBase }
Constructor TStdPacketBase.Create(const sFileName: String);
begin
Inherited Create;
Enc_ := TTgEncrypt.Create(PASS_ENC, ekNone);
ZeroMemory(@Header_, SizeOf(Header_));
nLastError_ := 0;
sFName_ := sFileName;
fs_ := nil;
end;
Destructor TStdPacketBase.Destroy;
begin
if Assigned(fs_) then
FreeAndNil(fs_);
if Header_.dwTaskType = TASK_DESTROY then
DeleteFile(PChar(sFName_));
FreeAndNil(Enc_);
Inherited;
end;
procedure TStdPacketBase.LoadStoredHeader;
begin
try
if Assigned(fs_) then
begin
ZeroMemory(@Header_, SizeOf(Header_));
fs_.Position := 0;
fs_.Read(Header_, SizeOf(Header_));
Enc_.EncKind := TTgEncKind(Header_.wEncType);
end;
except
on E: Exception do
ESavePacekt.TraceException(Self, E, 'Fail .. LoadStoredHeader()');
end;
end;
procedure TStdPacketBase.SetTaskType(dwTaskType: DWORD);
var
ll: LONGLONG;
begin
try
if Assigned(fs_) and (Header_.dwTaskType <> dwTaskType) then
begin
ll := fs_.Position;
fs_.Position := OFFSET_TASK_TYPE;
try
Header_.dwTaskType := dwTaskType;
fs_.Write(Header_.dwTaskType, SizeOf(Header_.dwTaskType));
// FlushFileBuffers(fs_.Handle);
finally
fs_.Position := ll;
end;
end;
except
on E: Exception do
ESavePacekt.TraceException(Self, E, 'Fail .. SetTaskType()');
end;
end;
function TStdPacketBase.GetTaskType: DWORD;
var
ll: LONGLONG;
begin
try
Result := TASK_UNKNOWN;
if Assigned(fs_) then
begin
ll := fs_.Position;
fs_.Position := OFFSET_TASK_TYPE;
try
fs_.Read(Header_.dwTaskType, SizeOf(Header_.dwTaskType));
finally
fs_.Position := ll;
end;
Result := Header_.dwTaskType;
end;
except
on E: Exception do
ESavePacekt.TraceException(Self, E, 'Fail .. GetTaskType()');
end;
end;
function TStdPacketBase.GetStoredSize: LONGLONG;
begin
Result := 0;
if Assigned(fs_) then
Result := fs_.Size;
end;
function TStdPacketBase.GetEntryCount: LONGLONG;
begin
Result := 0;
if Assigned(fs_) then
Result := Header_.llTotalEntry;
end;
procedure TStdPacketBase.IncEntry;
var
ll: LONGLONG;
begin
try
if Assigned(fs_) then
begin
ll := fs_.Position;
fs_.Position := OFFSET_TOTAL_ENTRY;
try
Inc(Header_.llTotalEntry);
fs_.Write(Header_.llTotalEntry, SizeOf(Header_.llTotalEntry));
finally
fs_.Position := ll;
end;
end;
except
on E: Exception do
ESavePacekt.TraceException(Self, E, 'Fail .. IncEntry()');
end;
end;
procedure TStdPacketBase.DecEntry;
begin
try
if Assigned(fs_) then
begin
Header_.llProcssOffset := fs_.Position;
try
fs_.Position := OFFSET_TOTAL_ENTRY;
Dec(Header_.llTotalEntry);
fs_.Write(Header_.llTotalEntry, SizeOf(Header_.llTotalEntry));
fs_.Write(Header_.llProcssOffset, SizeOf(Header_.llProcssOffset));
finally
fs_.Position := Header_.llProcssOffset;
end;
end;
except
on E: Exception do
ESavePacekt.TraceException(Self, E, 'Fail .. DecEntry()');
end;
end;
function TStdPacketBase.GetRemainSize: LONGLONG;
begin
Result := -1;
if Assigned(fs_) then
Result := fs_.Size - fs_.Position;
end;
function TStdPacketBase.GetFileSize: LONGLONG;
begin
Result := 0;
if Assigned(fs_) then
Result := fs_.Size;
end;
{ TSavePacket }
Constructor TSavePacket.Create(const sFileName: String; llMaxSize: LONGLONG = MAX_DATA_SIZE;
EncAlgorithm: TTgEncKind = ekNone; bSaveFileHideSystem: Boolean = false);
procedure InitSavePacket;
begin
try
if not FileExists(sFileName) then
begin
InitStoredHeader(llMaxSize, TASK_SAVE, EncAlgorithm, SIGN_KKU48);
if bSaveFileHideSystem then // 숨김, 시스템 속성 추가 22_0124 16:03:37 sunk
begin
fs_ := TFileStream.Create(sFileName, fmCreate or fmOpenReadWrite or fmShareDenyNone);
fs_.Free;
SetFileAttributes(PChar(sFileName), FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_SYSTEM);
fs_ := TFileStream.Create(sFileName, fmOpenReadWrite or fmShareDenyNone);
end else
fs_ := TFileStream.Create(sFileName, fmCreate or fmOpenReadWrite or fmShareDenyNone);
fs_.Write(Header_, SizeOf(Header_));
end else begin
fs_ := TFileStream.Create(sFileName, fmOpenReadWrite or fmShareDenyNone);
LoadStoredHeader;
fs_.Seek(0, soEnd);
end;
except
// 예외나면 씹지말고 위로 올리도록 수정
raise ESavePacekt.Create('Fail .. Create()');
end;
end;
begin
Inherited Create(sFileName);
// if bInit then
InitSavePacket;
end;
procedure TSavePacket.InitStoredHeader(llMaxSize: LONGLONG; dwTaskType: DWORD; aEncKind: TTgEncKind; wSign: WORD);
begin
ZeroMemory(@Header_, SizeOf(Header_));
StrCopy(Header_.sVer, VER_SOTRED);
Header_.llMaxSize := llMaxSize;
Header_.dwTaskType := TASK_SAVE;
Header_.wEncType := WORD(aEncKind);
Header_.wSign := SIGN_KKU48;
Enc_.EncKind := aEncKind;
end;
procedure TSavePacket.PushPacketBuf(aBuf: TBytes);
begin
try
PushPacketBuf(@aBuf[0], Length(aBuf));
except
on E: Exception do
ESavePacekt.TraceException(Self, E, 'Fail .. PushPacketBuf() .. 1');
end;
end;
procedure TSavePacket.PushPacketBuf(aBuf: Pointer; nLen: Integer);
var
pBuf: TBytes;
nEncLen: Integer;
begin
try
if fs_ <> nil then
begin
pBuf := Enc_.EncryptBufferEx(aBuf, nLen);
nEncLen := Length(pBuf);
if nEncLen >= nLen then // 패딩때문에 암호화 결과가 더 커질 수 있음 23_0516 09:40:07 kku
begin
fs_.Write(nEncLen, SIZE_INTEGER);
fs_.Write(pBuf[0], nEncLen);
IncEntry;
end;
end;
except
on E: Exception do
ESavePacekt.TraceException(Self, E, 'Fail .. PushPacketBuf() .. 2');
end;
end;
{ TLoadPacket }
Constructor TLoadPacket.Create(const sFileName: String; bInitLoad: Boolean = true);
procedure InitLoadPacket;
begin
if FileExists(sFileName) then
begin
try
fs_ := TFileStream.Create(sFileName, fmOpenReadWrite or fmShareDenyNone);
except
nLastError_ := ERROR_ACCESS_DENIED;
exit;
end;
LoadStoredHeader;
if bInitLoad then
InitLoadHeader;
end else
nLastError_ := ERROR_FILE_NOT_FOUND;
end;
begin
Inherited Create(sFileName);
nLastError_ := ERROR_SUCCESS;
InitLoadPacket;
end;
procedure TLoadPacket.InitLoadHeader;
begin
TaskType := TASK_LOAD;
if Header_.llProcssOffset > fs_.Position then
fs_.Position := Header_.llProcssOffset;
end;
function TLoadPacket.PopPacketBuf: TBytes;
var
pSrcBuf, pDecBuf: TBytes;
nLen: Integer;
begin
Result := nil;
if Assigned(fs_) then
begin
if SIZE_INTEGER > RemainSize then
exit;
if fs_.Read(nLen, SIZE_INTEGER) <> SIZE_INTEGER then
exit;
if nLen > RemainSize then
exit;
SetLength(pSrcBuf, nLen);
if fs_.Read(pSrcBuf[0], nLen) <> nLen then
exit;
DecEntry;
Result := Enc_.DecryptBufferEx(pSrcBuf, nLen);
end;
end;
{ TTgStoredPacket }
Constructor TTgStoredPacket.Create(const sSaveFN: String; EncAlgorithm: TTgEncKind = ekNone);
begin
Inherited Create;
bBlockMaxSize_ := false;
bSaveFileHideSystem_ := false;
EncAlgorithm_ := EncAlgorithm;
SavePacket_ := nil;
LoadPacket_ := nil;
ullMaxSize_ := 0;
ullSegmentSize_ := 50*1024*1024;
// ullLimitSize_ := 2*1024*1024;
sSaveFN_ := sSaveFN;
sFNameH_ := ExtractFileName(sSaveFN_);
end;
Destructor TTgStoredPacket.Destroy;
begin
if Assigned(LoadPacket_) then
FreeAndNil(LoadPacket_);
if Assigned(SavePacket_) then
FreeAndNil(SavePacket_);
Inherited;
end;
procedure TTgStoredPacket.SetSavePacketTaskType(dwTaskType: DWORD);
begin
if Assigned(SavePacket_) then
SavePacket_.TaskType := dwTaskType;
end;
procedure TTgStoredPacket.SetMaxSize(ullMaxSize: ULONGLONG);
begin
if ullMaxSize_ <> ullMaxSize then
ullMaxSize_ := ullMaxSize;
end;
procedure TTgStoredPacket.SetSegmentSize(ullSegmentSize: ULONGLONG);
begin
if ullSegmentSize_ <> ullSegmentSize then
ullSegmentSize_ := ullSegmentSize;
end;
function TTgStoredPacket.GetStoredSavePath: String;
begin
Result := '';
if Assigned(SavePacket_) then
Result := SavePacket_.sFName_;
end;
function TTgStoredPacket.GetStoredLoadPath: String;
begin
Result := '';
if Assigned(LoadPacket_) then
Result := LoadPacket_.sFName_;
end;
function TTgStoredPacket.GetFirstStoredPath: String;
var
wfd: TWin32FindData;
hSc: THandle;
sDir,
sPath: String;
// ullTotalSize: ULONGLONG;
PkFileList: TStringList;
i: Integer;
begin
Result := '';
try
// ullTotalSize := 0;
sDir := ExtractFilePath(sSaveFN_);
if not ForceDirectories(sDir) then
exit;
sPath := sDir + '*.*';
hSc := FindFirstFile(PChar(sPath), wfd);
if hSc = INVALID_HANDLE_VALUE then
exit;
Guard(PkFileList, TStringList.Create);
try
Repeat
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0) then
begin
if Pos(sFNameH_, wfd.cFileName) > 0 then
begin
// Inc(ullTotalSize, GetFileSize_path(sDir + wfd.cFileName));
PkFileList.Add(sDir + wfd.cFileName);
end;
end;
Until not FindNextFile(hSc, wfd);
finally
FindClose(hSc);
end;
if PkFileList.Count > 0 then
begin
PkFileList.CustomSort(StringListCompareFileCreateDate);
Result := PkFileList[0];
end;
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. ReduceOldStoredData()');
end;
end;
function TTgStoredPacket._CreateStoredSave: TSavePacket;
function ReduceOldStoredData: Boolean;
var
wfd: TWin32FindData;
hSc: THandle;
sDir,
sPath: String;
ullTotalSize: ULONGLONG;
PkFileList: TStringList;
i: Integer;
begin
Result := true;
try
ullTotalSize := 0;
sDir := ExtractFilePath(sSaveFN_);
if not ForceDirectories(sDir) then
Exit(false);
sPath := sDir + '*.*';
hSc := FindFirstFile(PChar(sPath), wfd);
if hSc = INVALID_HANDLE_VALUE then
Exit(false);
Guard(PkFileList, TStringList.Create);
try
Repeat
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0) then
begin
if Pos(sFNameH_, wfd.cFileName) > 0 then
begin
Inc(ullTotalSize, GetFileSize_path(sDir + wfd.cFileName));
PkFileList.Add(sDir + wfd.cFileName);
end;
end;
Until not FindNextFile(hSc, wfd);
finally
FindClose(hSc);
end;
if ullMaxSize_ <= ullTotalSize then
begin
if bBlockMaxSize_ then
Exit(false);
PkFileList.CustomSort(StringListCompareFileCreateDate);
for i := 0 to PkFileList.Count - 1 do
begin
Dec(ullTotalSize, GetFileSize_path(PkFileList[i]));
DeleteFile(PChar(PkFileList[i]));
if ullMaxSize_ > ullTotalSize then
break;
end;
end;
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. ReduceOldStoredData()');
end;
end;
var
i, c: Integer;
sPath, sLoad: String;
begin
Result := nil;
try
if ullMaxSize_ > 0 then
begin
// 최대 저장 크기 체크해서 넘으면 오래된 덩어리 지워주기
if not ReduceOldStoredData then
exit;
end;
c := -1;
sLoad := '';
if Assigned(LoadPacket_) then
sLoad := LoadPacket_.FileName;
for i := 1 to High(Integer) do
begin
sPath := Format('%s.%.4d.dat', [sSaveFN_, i]);
if sLoad <> sPath then
begin
if FileExists(sPath) then
begin
try
if not ForceDirectories(ExtractFilePath(sPath)) then
begin
_Trace('Fail CreateDir .. Path = "%s"', [ExtractFilePath(sPath)]);
exit;
end;
Result := TSavePacket.Create(sPath, ullSegmentSize_, EncAlgorithm_, bSaveFileHideSystem_);
// 용량 꽉찬건지도 다시 확인 12_1206 09:16 sunk
if Result.GetStoredSize > ullSegmentSize_ then
Result.TaskType := TASK_SAVE_FULL;
case Result.Header_.dwTaskType of
TASK_SAVE : exit;
TASK_LOAD,
TASK_SAVE_FULL : FreeAndNil(Result);
TASK_DESTROY :
begin
FreeAndNil(Result);
DeleteFile(PChar(sPath));
c := i;
break;
end;
else
begin
{$IFDEF DEBUG}
ASSERT(false);
{$ELSE}
FreeAndNil(Result);
DeleteFile(PChar(sPath));
c := i;
break;
{$ENDIF}
end;
end;
except
if Assigned(Result) then
FreeAndNil(Result);
continue;
end;
end else begin
c := i;
break;
end;
end;
end;
if Result = nil then
begin
if c > -1 then
begin
if not ForceDirectories(ExtractFilePath(sSaveFN_)) then
begin
_Trace('Fail CreateDir .... Path = "%s"', [ExtractFilePath(sSaveFN_)]);
exit;
end;
Result := TSavePacket.Create(Format('%s.%.4d.dat', [sSaveFN_, c]), ullSegmentSize_, EncAlgorithm_, bSaveFileHideSystem_)
end else
// 여기까지 왔다면 파일 생성이 불가능한 상황으로 판단 17_0515 16:22:35 sunk
_Trace('Exception .. _CreateStoredSave() .. Files can no longer be created. LastPath = [%s]', [sPath]);
// Result := TSavePacket.Create(Format('%s.%.4d.dat', [sSaveFN_, c]), ullSegmentSize_, EncAlgorithm_, bSaveFileHideSystem_);
// _Trace('_CreateStoredSave() - Path = %s', [Result.sFileName_]);
end;
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. _CreateStoredSave()');
end;
end;
function TTgStoredPacket._CreateStoredLoad: TLoadPacket;
var
i: Integer;
hSc: THandle;
sDir,
sPath, sSave: String;
wfd: TWin32FindData;
begin
Result := nil;
try
sSave := '';
if Assigned(SavePacket_) then
sSave := SavePacket_.FileName;
sDir := IncludeTrailingBackslash(ExtractFilePath(sSaveFN_));
sPath := sDir + '*.*';
hSc := FindFirstFile(PChar(sPath), wfd);
if hSc = INVALID_HANDLE_VALUE then
exit;
try
Repeat
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
begin
end else begin
if Pos(sFNameH_ + '.', wfd.cFileName) > 0 then
begin
sPath := sDir + wfd.cFileName;
if (sSave <> sPath) and FileExists(sPath) then
begin
Result := TLoadPacket.Create(sPath);
case Result.Header_.dwTaskType of
TASK_LOAD : exit;
TASK_SAVE,
TASK_SAVE_FULL :
begin
Result.SetTaskType(TASK_LOAD);
exit;
end;
// TASK_DESTROY :
else
begin
FreeAndNil(Result);
DeleteFile(PChar(sPath));
end;
// else ASSERT(false);
end;
end;
end;
end;
Until not FindNextFile(hSc, wfd);
finally
Winapi.Windows.FindClose(hSc);
end;
if (Result = nil) and Assigned(SavePacket_) then
begin
FreeAndNil(SavePacket_);
Result := TLoadPacket.Create(sSave); // todo : LastError 체크해서 후 처리
Result.SetTaskType(TASK_LOAD);
end;
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. _CreateStoredLoad()');
end;
end;
procedure TTgStoredPacket.PushPacket(aPacket: ITgPacket);
var
pBuf: TBytes;
begin
try
if aPacket.ToBytesDataOnly(pBuf) > 0 then
PushPacket(pBuf);
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. PushPacket() .... 0');
end;
end;
procedure TTgStoredPacket.PushPacket(pPktBuf: TBytes);
begin
try
PushPacket(@pPktBuf[0], Length(pPktBuf));
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. PushPacket() .... 1');
end;
end;
procedure TTgStoredPacket.PushPacket(pPktBuf: Pointer; nLen: Integer);
begin
try
if Assigned(SavePacket_) then
if SavePacket_.GetStoredSize > ullSegmentSize_ then
begin
SavePacket_.TaskType := TASK_SAVE_FULL;
FreeAndNil(SavePacket_);
end else
if SavePacket_.TaskType <> TASK_SAVE then
FreeAndNil(SavePacket_);
if not Assigned(SavePacket_) then
SavePacket_ := _CreateStoredSave;
if Assigned(SavePacket_) then
SavePacket_.PushPacketBuf(pPktBuf, nLen);
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. PushPacket() .... 2');
end;
end;
procedure TTgStoredPacket.PushPacket(sPacket: UTF8String);
begin
PushPacket(@sPacket[1], Length(sPacket));
end;
function TTgStoredPacket.PopPacketStr: String;
var
bCreate: Boolean;
sPath: String;
pBuf: TBytes;
bPopSuccess: Boolean;
Label
LB_DoPopPacket;
begin
Result := '';
try
bCreate := false;
if not Assigned(LoadPacket_) then
begin
LoadPacket_ := _CreateStoredLoad;
if not Assigned(LoadPacket_) then
exit;
bCreate := true;
end;
LB_DoPopPacket :
bPopSuccess := false;
try
pBuf := LoadPacket_.PopPacketBuf;
bPopSuccess := pBuf <> nil;
except
Result := '';
end;
if bPopSuccess then
begin
try
Result := TEncoding.UTF8.GetString(pBuf); // UTF8ToWideString(PAnsiChar(pBuf));
// Result := TTgPacket.Create(pBuf, true);
except
_Trace('Conv .. Fail! TTgPacketCreate. ');
// raise;
Result := '';
end;
end;
if not bPopSuccess then
begin
sPath := LoadPacket_.FileName;
LoadPacket_.SetTaskType(TASK_DESTROY);
FreeAndNil(LoadPacket_);
DeleteFile(PChar(sPath));
if not bCreate then
Result := PopPacketStr;
end else
if Result = '' then
begin
// TEncoding.UTF8.GetString() 에서 디코딩 실패 시 수집 데이터 전체 지우지 말고
// 넘기고 다시 시도 하도록 보완 20_0804 12:44:27 sunk
goto LB_DoPopPacket;
end;
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. PopPacketStr() .... 1');
end;
end;
function TTgStoredPacket.PopPacket: ITgPacket;
begin
Result := nil;
try
Result := TTgPacket.Create(PopPacketStr);
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. PopPacketStr() .... 2');
end;
end;
procedure TTgStoredPacket.SafeFreeSaveStored(const sPath: String; dwTaskType: DWORD);
begin
try
// 외부에서 해당 조건(Path)의 SaveStored가 사용중이라면 dwTaskType값으로 바꿔주고 해제해 준다. 14_0709 14:18:56 sunk
if Assigned(SavePacket_) and (SavePacket_.sFName_ = sPath) then
begin
SavePacket_.SetTaskType(dwTaskType);
FreeAndNil(SavePacket_);
end;
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. SafeFreeSaveStored');
end;
end;
{ TTgStoredMirrorPacket }
Constructor TTgStoredPacketMirror.Create(sPaths, sFName: String; EncAlgorithm: TTgEncKind = ekNone);
procedure InitEnt;
var
PathList: TStringList;
i: Integer;
pEnt: PSpmEnt;
begin
if sPaths <> '' then
begin
Guard(PathList, TStringList.Create);
SplitString('|', sPaths, PathList);
for i := 0 to PathList.Count - 1 do
if ForceDirectories(PathList[i]) then
begin
New(pEnt);
pEnt.sSaveFN := IncludeTrailingBackslash(PathList[i]) + sFName;
pENt.SavePacket := nil;
SpmEntList_.Add(pEnt);
end else
_Trace('Fail .. make dir .. Path="%s"', [PathList[i]]);
end;
end;
begin
Inherited Create;
EncAlgorithm_ := EncAlgorithm;
ullSegmentSize_ := 50*1024*1024;
bSaveFileHideSystem_ := false;
SpmEntList_ := TSpmEntList.Create;
SpmEntList_.OnNotify := OnSpmEntNotify;
InitEnt;
end;
Destructor TTgStoredPacketMirror.Destroy;
begin
FreeAndNil(SpmEntList_);
Inherited;
end;
procedure TTgStoredPacketMirror.OnSpmEntNotify(Sender: TObject; const Item: PSpmEnt; Action: TCollectionNotification);
begin
case Action of
cnAdded: ;
cnRemoved:
begin
if Item.SavePacket <> nil then
FreeAndNil(Item.SavePacket);
Dispose(Item);
end;
cnExtracted: ;
end;
end;
procedure TTgStoredPacketMirror.SetSegmentSize(ullSegmentSize: ULONGLONG);
begin
if ullSegmentSize_ <> ullSegmentSize then
ullSegmentSize_ := ullSegmentSize;
end;
function TTgStoredPacketMirror.GetSegmentSize: ULONGLONG;
begin
Result := ullSegmentSize_;
end;
function TTgStoredPacketMirror._CreateStoredSave(sSaveFN: String): TSavePacket;
var
i, c: Integer;
sPath, sLoad: String;
begin
Result := nil;
try
c := -1;
sLoad := '';
for i := 1 to High(Integer) - 1 do
begin
sPath := Format('%s.%.4d.dat', [sSaveFN, i]);
if sLoad <> sPath then
begin
if FileExists(sPath) then
begin
try
if not ForceDirectories(ExtractFilePath(sPath)) then
begin
_Trace('Fail CreateDir .. Path = "%s"', [ExtractFilePath(sPath)]);
exit;
end;
Result := TSavePacket.Create(sPath, ullSegmentSize_, EncAlgorithm_, bSaveFileHideSystem_);
// 용량 꽉찬건지도 다시 확인 12_1206 09:16 sunk
if Result.GetStoredSize > ullSegmentSize_ then
Result.TaskType := TASK_SAVE_FULL;
case Result.Header_.dwTaskType of
TASK_SAVE : exit;
TASK_LOAD,
TASK_SAVE_FULL : FreeAndNil(Result);
TASK_DESTROY :
begin
FreeAndNil(Result);
DeleteFile(PChar(sPath));
c := i;
break;
end;
else
begin
{$IFDEF DEBUG}
ASSERT(false);
{$ELSE}
FreeAndNil(Result);
DeleteFile(PChar(sPath));
c := i;
break;
{$ENDIF}
end;
end;
except
if Assigned(Result) then
FreeAndNil(Result);
continue;
end;
end else begin
c := i;
break;
end;
end;
end;
if Result = nil then
begin
if c > -1 then
begin
if not ForceDirectories(ExtractFilePath(sSaveFN)) then
begin
_Trace('Fail CreateDir .... Path = "%s"', [ExtractFilePath(sSaveFN)]);
exit;
end;
Result := TSavePacket.Create(Format('%s.%.4d.dat', [sSaveFN, c]), ullSegmentSize_, EncAlgorithm_, bSaveFileHideSystem_)
end else
// 여기까지 왔다면 파일 생성이 불가능한 상황으로 판단 17_0515 16:22:35 sunk
_Trace('Exception .. _CreateStoredSave() .. Files can no longer be created. LastPath = [%s]', [sPath]);
end;
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. _CreateStoredSave()');
end;
end;
procedure TTgStoredPacketMirror.PushPacket(aPacket: ITgPacket);
var
pBuf: TBytes;
begin
try
if (SpmEntList_.Count > 0) and (aPacket.ToBytesDataOnly(pBuf) > 0) then
PushPacket(pBuf);
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. PushPacket() .... 0');
end;
end;
procedure TTgStoredPacketMirror.PushPacket(pPktBuf: TBytes);
begin
try
if SpmEntList_.Count > 0 then
PushPacket(@pPktBuf[0], Length(pPktBuf));
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. PushPacket() .... 1');
end;
end;
procedure TTgStoredPacketMirror.PushPacket(pPktBuf: Pointer; nLen: Integer);
var
i: Integer;
begin
try
for i := 0 to SpmEntList_.Count - 1 do
begin
if Assigned(SpmEntList_[i].SavePacket) then
if SpmEntList_[i].SavePacket.GetStoredSize > ullSegmentSize_ then
begin
SpmEntList_[i].SavePacket.TaskType := TASK_SAVE_FULL;
FreeAndNil(SpmEntList_[i].SavePacket);
end else
if SpmEntList_[i].SavePacket.TaskType <> TASK_SAVE then
FreeAndNil(SpmEntList_[i].SavePacket);
if not Assigned(SpmEntList_[i].SavePacket) then
SpmEntList_[i].SavePacket := _CreateStoredSave(SpmEntList_[i].sSaveFN);
if Assigned(SpmEntList_[i].SavePacket) then
SpmEntList_[i].SavePacket.PushPacketBuf(pPktBuf, nLen);
end;
except
on E: Exception do
ECrmStoredPacket.TraceException(Self, E, 'Fail .. PushPacket() .... 2');
end;
end;
end.