アプリケーションレイヤーネットワークプロトコルの複雑さの解消

指でタスクを設定する

形式化

額の決定

輸送

コードの最初のバージョン

 TForm1 = class(TForm) TCPClient: TIdTCPClient; ButtonSync: TButton; StoredProcLists: TFDStoredProc; procedure ButtonSyncClick(Sender: TObject); end; 

 procedure TForm1.ButtonSyncClick(Sender: TObject); var Handler: TIdIOHandler; begin TCPClient.Connect; Handler := TCPClient.IOHandler; //     ... //    ... //   ... //  : // 1.    ... // 2.    ... // 3.   //  ,   . StoredProcLists.Open; Handler.Write(StoredProcLists.RecordCount); while not StoredProcLists.Eof do begin Handler.Write( StoredProcLists.FieldByName('ListID').AsInteger ); Handler.Write( Length(StoredProcLists.FieldByName('ListHash').AsBytes) ); Handler.Write( StoredProcLists.FieldByName('ListHash').AsBytes ); Handler.Write( Length(StoredProcLists.FieldByName('ListUsersHash').AsBytes) ); Handler.Write( StoredProcLists.FieldByName('ListUsersHash').AsBytes ); Handler.Write( Length(StoredProcLists.FieldByName('ListItemsHash').AsBytes) ); Handler.Write( StoredProcLists.FieldByName('ListItemsHash').AsBytes ); StoredProcLists.Next; end; StoredProcLists.Close; //    . if Handler.ReadByte = 1 then //  ? ... //  -  . else ... //  -   . TCPClient.Disconnect; end; 

• せっけん、プロトコルの構造、その論理段階、および送信データを曖昧にすることは、将来の改善を大きく複雑にします。
• 特定のネットワークライブラリ（Indy）へのリンク：変更があった場合、コードボリューム全体を綿密にくまなく確認するために、エラーを伴う深刻な作業が必要になります。
• データソース（ DB ）だけでなく、それらへのアクセスのコンポーネント（ FireDAC ）への同様のバインディング-これには同じ問題が伴います。

最初のアプローチ

プロトコル

 unit Net.Protocol; interface uses IdIOHandler; type TNetTransport = TIdIOHandler; TNetProtocol = class abstract protected FTransport: TNetTransport; public constructor Create(const Transport: TNetTransport); procedure RunExchange; virtual; abstract; end; implementation constructor TNetProtocol.Create(const Transport: TNetTransport); begin FTransport := Transport; end; end. 

 procedure TForm1.ButtonSyncClick(Sender: TObject); var Protocol: TClientProtocol; begin TCPClient.Connect; Protocol := TClientProtocol.Create(TCPClient.IOHandler); try Protocol.RunExchange; finally Protocol.Free; end; TCPClient.Disconnect; end; 

パッケージ

 unit Net.Packet; interface uses Net.Protocol; type TPacket = class abstract public type TPacketKind = UInt16; protected FTransport: TNetTransport; function Kind: TPacketKind; virtual; abstract; public constructor Create(const Transport: TNetTransport); procedure Send; procedure Receive; end; implementation constructor TPacket.Create(const Transport: TNetTransport); begin FTransport := Transport; end; procedure TPacket.Send; begin FTransport.Write(Kind); end; procedure TPacket.Receive; var ActualKind: TPacketKind; begin ActualKind := FTransport.ReadUInt16; if Kind <> ActualKind then //    . ... end; end. 

 unit Sync.Packets; interface uses System.Generics.Collections, Net.Packet; type TListHashesPacket = class(TPacket) private const PacketKind = 1; public type THashes = class strict private FHash: string; FItemsHash: string; FUsersHash: string; public property Hash: string read FHash write FHash; property UsersHash: string read FUsersHash write FUsersHash; property ItemsHash: string read FItemsHash write FItemsHash; end; TListHashes = TObjectDictionary<Integer, THashes>; //   - ID . private FHashes: TListHashes; protected function Kind: TPacket.TPacketKind; override; public property Hashes: TListHashes read FHashes write FHashes; end; TListHashesResponsePacket = class(TPacket) private const PacketKind = 2; private FHashesMatched: Boolean; protected function Kind: TPacket.TPacketKind; override; public property HashesMatched: Boolean read FHashesMatched write FHashesMatched; end; //   . ... implementation function TListHashesPacket.Kind: TPacket.TPacketKind; begin Result := PacketKind; end; function TListHashesResponsePacket.Kind: TPacket.TPacketKind; begin Result := PacketKind; end; end. 

プロトコル実装

 unit Sync.Protocol.Client; interface uses Net.Protocol; type TClientProtocol = class(TNetProtocol) private procedure SendListHashes; function ListHashesMatched: Boolean; ... public procedure RunExchange; override; end; implementation uses Sync.Packets; procedure TClientProtocol.RunExchange; begin inherited; ... // 3.   SendListHashes; if ListHashesMatched then //  ? ... //  -  . else ... //  -   . end; procedure TClientProtocol.SendListHashes; var ListHashesPacket: TListHashesPacket; begin ListHashesPacket := TListHashesPacket.Create(FTransport); try //  ListHashesPacket.Hashes   . ... ListHashesPacket.Send; finally ListHashesPacket.Free; end; end; function TClientProtocol.ListHashesMatched: Boolean; var ListHashesResponsePacket: TListHashesResponsePacket; begin ListHashesResponsePacket := TListHashesResponsePacket.Create(FTransport); try ListHashesResponsePacket.Receive; Result := ListHashesResponsePacket.HashesMatched; finally ListHashesResponsePacket.Free; end; end; end. 

 unit Sync.Protocol.Server; interface uses Net.Protocol; type TServerProtocol = class(TNetProtocol) private function ListHashesMatched: Boolean; ... public procedure RunExchange; override; end; implementation uses Sync.Packets; procedure TServerProtocol.RunExchange; begin inherited; ... // 3.   if ListHashesMatched then //  ? ... //  -  . else ... //  -   . end; function TServerProtocol.ListHashesMatched: Boolean; var ClientListHashesPacket: TListHashesPacket; ListHashesResponsePacket: TListHashesResponsePacket; begin ClientListHashesPacket := TListHashesPacket.Create(FTransport); try ClientListHashesPacket.Receive; ListHashesResponsePacket := TListHashesResponsePacket.Create(FTransport); try //  ClientListHashesPacket.Hashes    , //  ListHashesResponsePacket.HashesMatched. ... ListHashesResponsePacket.Send; Result := ListHashesResponsePacket.HashesMatched; finally ListHashesResponsePacket.Free; end; finally ClientListHashesPacket.Free; end; end; end. 

最終オプション

データ

 //  ListHashesPacket.Hashes   . ... ListHashesPacket.Send; 

 //  ClientListHashesPacket.Hashes    , //  ListHashesResponsePacket.HashesMatched. ... ListHashesResponsePacket.Send; 

 unit Sync.DB; interface uses FireDAC.Comp.Client; type TDBFacade = class abstract protected FConnection: TFDConnection; public constructor Create; destructor Destroy; override; procedure StartTransaction; procedure CommitTransaction; procedure RollbackTransaction; end; implementation constructor TDBFacade.Create; begin FConnection := TFDConnection.Create(nil); end; destructor TDBFacade.Destroy; begin FConnection.Free; inherited; end; procedure TDBFacade.StartTransaction; begin FConnection.StartTransaction; end; procedure TDBFacade.CommitTransaction; begin FConnection.Commit; end; procedure TDBFacade.RollbackTransaction; begin FConnection.Rollback; end; end. 

 unit Sync.DB.Client; interface uses Sync.DB, Sync.Packets; type TClientDBFacade = class(TDBFacade) public procedure CalcListHashes(const Hashes: TListHashesPacket.TListHashes); ... end; implementation uses FireDAC.Comp.Client; procedure TClientDBFacade.CalcListHashes(const Hashes: TListHashesPacket.TListHashes); var StoredProcHashes: TFDStoredProc; begin StoredProcHashes := TFDStoredProc.Create(nil); try //  StoredProcHashes. ... StoredProcHashes.Open; while not StoredProcHashes.Eof do begin //  Hashes. ... StoredProcHashes.Next; end; finally StoredProcHashes.Free; end; end; end. 

 unit Sync.DB.Server; interface uses Sync.DB, Sync.Packets; type TServerDBFacade = class(TDBFacade) public function CompareListHashes(const ClientHashes: TListHashesPacket.TListHashes): Boolean; ... end; implementation uses FireDAC.Comp.Client; function TServerDBFacade.CompareListHashes(const ClientHashes: TListHashesPacket.TListHashes): Boolean; var StoredProcHashes: TFDStoredProc; begin Result := True; StoredProcHashes := TFDStoredProc.Create(nil); try //  StoredProcHashes. ... StoredProcHashes.Open; //   . while not StoredProcHashes.Eof do begin Result := Result and {       ClientHashes?}; StoredProcHashes.Next; end; finally StoredProcHashes.Free; end; end; end. 

 procedure TClientSyncDBFacade.CalcListHashes(const Hashes: TListHashesPacket.THashesCollection); var Lists: TList<TLocalListID>; procedure PrepareListsToHashing; begin PrepareStoredProcedureToWork(SyncPrepareListsToHashingProcedure); FStoredProcedure.Open; while not FStoredProcedure.Eof do begin Lists.Add( FStoredProcedure['LIST_ID'] ); FStoredProcedure.Next; end; end; procedure CalcTotalChildHashes; var ListID: TLocalListID; TotalUsersHash, TotalItemsHash: TMD5Hash; begin for ListID in Lists do begin PrepareStoredProcedureToWork(SyncSelectListUsersForHashingProcedure); FStoredProcedure.ParamByName('LIST_ID').Value := ListID; TotalUsersHash := CalcTotalHashAsBytes( FStoredProcedure, ['USER_AS_STRING'] ); PrepareStoredProcedureToWork(SyncSelectListItemAndItemMessagesHashProcedure); FStoredProcedure.ParamByName('LIST_ID').Value := ListID; TotalItemsHash := CalcTotalHashAsBytes( FStoredProcedure, ['ITEM_HASH', 'ITEM_MESSAGES_HASH'] ); PrepareStoredProcedureToWork(SyncAddTotalListHashesProcedure); FStoredProcedure.ParamByName('LIST_ID').Value := ListID; FStoredProcedure.ParamByName('TOTAL_USERS_HASH').AsHash := TotalUsersHash; FStoredProcedure.ParamByName('TOTAL_ITEMS_HASH').AsHash := TotalItemsHash; FStoredProcedure.ExecProc; end; end; procedure FillHashes; var ListHashes: TListHashesPacket.THashes; begin PrepareStoredProcedureToWork(SyncSelectListHashesProcedure); FStoredProcedure.Open; while not FStoredProcedure.Eof do begin ListHashes := TListHashesPacket.THashes.Create; try ListHashes.Hash := HashToString( FStoredProcedure.FieldByName('LIST_HASH').AsHash ); ListHashes.UsersHash := HashToString( FStoredProcedure.FieldByName('LIST_USERS_HASH').AsHash ); ListHashes.ItemsHash := HashToString( FStoredProcedure.FieldByName('LIST_ITEMS_HASH').AsHash ); except ListHashes.DisposeOf; raise; end; Hashes.Add( FStoredProcedure.FieldByName('LIST_GLOBAL_ID').AsUUID, ListHashes ); FStoredProcedure.Next; end; end; begin Lists := TList<TLocalListID>.Create; try PrepareListsToHashing; CalcRecordHashes(TListHashes); CalcRecordHashes(TListItemHashes); CalcRecordHashes(TListItemMessagesHashes); CalcTotalChildHashes; FillHashes; finally Lists.DisposeOf; end; end; 

最終プロトコルビュー

 unit Sync.Protocol.Client; interface uses Net.Protocol, Sync.DB.Client; type TClientProtocol = class(TNetProtocol) private FDBFacade: TClientDBFacade; procedure SendListHashes; ... public procedure RunExchange; override; end; implementation uses Sync.Packets; procedure TClientProtocol.RunExchange; begin inherited; FDBFacade.StartTransaction; try ... // 3.   SendListHashes; if ListHashesMatched then //  ? ... //  -  . else ... //  -   . FDBFacade.CommitTransaction; except FDBFacade.RollbackTransaction; raise; end; end; procedure TClientProtocol.SendListHashes; var ListHashesPacket: TListHashesPacket; begin ListHashesPacket := TListHashesPacket.Create(FTransport); try FDBFacade.CalcListHashes(ListHashesPacket.Hashes); ListHashesPacket.Send; finally ListHashesPacket.Free; end; end; ... end. 

 unit Sync.Protocol.Server; interface uses Net.Protocol, Sync.DB.Server; type TServerProtocol = class(TNetProtocol) private FDBFacade: TServerDBFacade; function ListHashesMatched: Boolean; ... public procedure RunExchange; override; end; implementation uses Sync.Packets; procedure TServerProtocol.RunExchange; begin inherited; FDBFacade.StartTransaction; try ... // 3.   if ListHashesMatched then //  ? ... //  -  . else ... //  -   . FDBFacade.CommitTransaction; except FDBFacade.RollbackTransaction; raise; end; end; function TServerProtocol.ListHashesMatched: Boolean; var ClientListHashesPacket: TListHashesPacket; ListHashesResponsePacket: TListHashesResponsePacket; begin ClientListHashesPacket := TListHashesPacket.Create(FTransport); try ClientListHashesPacket.Receive; ListHashesResponsePacket := TListHashesResponsePacket.Create(FTransport); try ListHashesResponsePacket.HashesMatched := FDBFacade.CompareListHashes(ClientListHashesPacket.Hashes); ListHashesResponsePacket.Send; Result := ListHashesResponsePacket.HashesMatched; finally ListHashesResponsePacket.Free; end; finally ClientListHashesPacket.Free; end; end; end. 

パッケージ改訂

• まず、ネットワークを介した伝送に適した形式でデータをパック （ シリアル化 ）する必要があります。
• パッケージ化されたものを物理的に送信する必要があります。

 unit Net.Packet; interface uses Net.Protocol, System.JSON; type TPacket = class abstract ... private function PackToJSON: TJSONObject; procedure UnpackFromJSON(const JSON: TJSONObject); ... end; 

 TListPacket = class(TStreamPacket) public type TPhoto = class(TPackableObject) strict private FSortOrder: Int16; FItemMessageID: TItemMessageID; public property ItemMessageID: TItemMessageID read FItemMessageID write FItemMessageID; property SortOrder: Int16 read FSortOrder write FSortOrder; end; TPhotos = TStandardPacket.TPackableObjectDictionary<TMessagePhotoID, TPhoto>; TMessage = class(TPackableObject) strict private FAuthor: TUserID; FAddDate: TDateTime; FText: string; FListItemID: TListItemID; public property ListItemID: TListItemID read FListItemID write FListItemID; property Author: TUserID read FAuthor write FAuthor; property AddDate: TDateTime read FAddDate write FAddDate; property Text: string read FText write FText; end; TMessages = TStandardPacket.TPackableObjectDictionary<TItemMessageID, TMessage>; TListDescendant = class(TPackableObject) strict private FListID: TListID; public property ListID: TListID read FListID write FListID; end; TItem = class(TListDescendant) strict private FAddDate: TDateTime; FAmount: TAmount; FEstimatedPrice: Currency; FExactPrice: Currency; FStandardGoods: TID; FInTrash: Boolean; FUnitOfMeasurement: TID; FStrikeoutDate: TDateTime; FCustomGoods: TGoodsID; public property StandardGoods: TID read FStandardGoods write FStandardGoods; property CustomGoods: TGoodsID read FCustomGoods write FCustomGoods; property Amount: TAmount read FAmount write FAmount; property UnitOfMeasurement: TID read FUnitOfMeasurement write FUnitOfMeasurement; property EstimatedPrice: Currency read FEstimatedPrice write FEstimatedPrice; property ExactPrice: Currency read FExactPrice write FExactPrice; property AddDate: TDateTime read FAddDate write FAddDate; property StrikeoutDate: TDateTime read FStrikeoutDate write FStrikeoutDate; property InTrash: Boolean read FInTrash write FInTrash; end; TItems = TStandardPacket.TPackableObjectDictionary<TListItemID, TItem>; TUser = class(TListDescendant) strict private FUserID: TUserID; public property UserID: TUserID read FUserID write FUserID; end; TUsers = TStandardPacket.TPackableObjectList<TUser>; TList = class(TPackableObject) strict private FName: string; FAuthor: TUserID; FAddDate: TDateTime; FDeadline: TDate; FInTrash: Boolean; public property Author: TUserID read FAuthor write FAuthor; property Name: string read FName write FName; property AddDate: TDateTime read FAddDate write FAddDate; property Deadline: TDate read FDeadline write FDeadline; property InTrash: Boolean read FInTrash write FInTrash; end; TLists = TStandardPacket.TPackableObjectDictionary<TListID, TList>; private FLists: TLists; FMessages: TMessages; FItems: TItems; FUsers: TUsers; FPhotos: TPhotos; public property Lists: TLists read FLists write FLists; property Users: TUsers read FUsers write FUsers; property Items: TItems read FItems write FItems; property Messages: TMessages read FMessages write FMessages; property Photos: TPhotos read FPhotos write SetPhotos; end; 

 { 16: { Hash: "d0860029f1400147deef86d3246d29a4", UsersHash: "77febf816dac209a22880c313ffae6ad", ItemsHash: "1679091c5a880faf6fb5e6087eb1b2dc" }, 38: { Hash: "81c8061686c10875781a2b37c398c6ab", UsersHash: "d3556bff1785e082b1508bb4e611c012", ItemsHash: "0e3a37aa85a14e359df74fa77eded3f6" } } 

 unit Net.Packet; interface ... implementation uses System.SysUtils, IdGlobal; ... procedure TPacket.Send; var DataLength: Integer; RawData: TBytes; JSON: TJSONObject; begin FTransport.Write(Kind); JSON := PackToJSON; try SetLength(RawData, JSON.EstimatedByteSize); DataLength := JSON.ToBytes( RawData, Low(RawData) ); FTransport.Write(DataLength); FTransport.Write( TIdBytes(RawData), DataLength ); finally JSON.Free; end; end; procedure TPacket.Receive; var ActualKind: TPacketKind; DataLength: Integer; RawData: TBytes; JSON: TJSONObject; begin ActualKind := FTransport.ReadUInt16; if Kind <> ActualKind then //    . ... DataLength := FTransport.ReadInt32; FTransport.ReadBytes( TIdBytes(RawData), DataLength, False ); JSON := TJSONObject.Create; try JSON.Parse(RawData, 0); UnpackFromJSON(JSON); finally JSON.Free; end; end; ... end. 

おわりに