{*******************************************************} { } { 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; 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.