請問有關indy元件Tunnel如何使用?? |
尚未結案
|
rambo287
一般會員 發表:17 回覆:4 積分:4 註冊:2002-06-07 發送簡訊給我 |
|
hagar
版主 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
http://groups.google.com.tw/groups?hl=zh-TW&lr=&ie=UTF-8&inlang=zh-TW&selm=3cf2957a_2%40dnews&rnum=6
{* CryptedTunnel components module Copyright (C) 1999, 2000, 2001 Gregor Ibic (gregor.ibic@intelicom.si) Intelicom d.o.o. All rights reserved. This package is a Crypted Tunnel implementation written by Gregor Ibic (gregor.ibic@intelicom.si). This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented, you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. *} unit CryptedTunnel; interface {$DEFINE COMPRESS} {$DEFINE BZIP2} //{$DEFINE LZRW} uses SysUtils, Classes, syncobjs, IdTunnelMaster, IdTunnelSlave, IdTunnelCommon, IdTCPServer, IdGlobal, IdComponent, MiniCrypt, {$IFDEF COMPRESS} {$IFDEF LZRW} LZRW1KH, // LZRW kompresija {$ENDIF} {$IFDEF BZIP2} Compressors, // Bzip2 kompresija {$ENDIF} {$ENDIF} Capi, uCAUtils; type TTunnelMode = (stmDisconnected, stmConnecting, stmAuthenicating, stmAuthenicated, stmNotAuthenicated); // Slave thread user defined data TSlaveUserData = class(TObject) public fClientAuthorised: Boolean; fAuthorised: Boolean; fAddressAuthorised: Boolean; fCryptor: TMiniEncryptor; {$IFDEF COMPRESS} {$IFDEF LZRW} fCompressor: TLZR; {$ENDIF} {$IFDEF BZIP2} fCompressor: TCompressor; {$ENDIF} {$ENDIF} fpCompBuffer: PChar; fpDeCompBuffer: PChar; fpEncrBuffer: PChar; end; TCryptedTunnelMaster = class(TIdTunnelMaster) private { Private declarations } // Properties fDSN: String; fUser: String; fKeyFile: String; fPassword: String; // Events fOnConnect, fOnDisconnect, fOnTransformRead: TIdServerThreadEvent; fOnTransformSend: TSendTrnEvent; fOnInterpretMsg: TSendMsgEvent; Locker: TCriticalSection; protected { Protected declarations } procedure DoConnect(Thread: TIdPeerThread); override; procedure DoDisconnect(Thread: TIdPeerThread); override; procedure DoTransformRead(Thread: TIdPeerThread); override; procedure DoTransformSend(Thread: TIdPeerThread; var Header: TIdHeader; var CustomMsg: String); override; procedure DoInterpretMsg(Thread: TIdPeerThread; var CustomMsg: String); override; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure GetUserList(var UserList: TStringList); procedure KillUser(UserID: Integer); published { Published declarations } property DSN: String read fDSN write fDSN; property User: String read fUser write fUser; property KeyFile: String read fKeyFile write fKeyFile; property Password: String read fPassword write fPassword; property OnConnect: TIdServerThreadEvent read FOnConnect write FOnConnect; property OnDisconnect: TIdServerThreadEvent read FOnDisconnect write FOnDisconnect; property OnTransformRead: TIdServerThreadEvent read fOnTransformRead write fOnTransformRead; property OnTransformSend: TSendTrnEvent read fOnTransformSend write fOnTransformSend; property OnInterpretMsg: TSendMsgEvent read fOnInterpretMsg write fOnInterpretMsg; end; TCryptedTunnelSlave = class(TIdTunnelSlave) private { Private declarations } // Properties fCryptor: TMiniEncryptor; fAuthorised: Boolean; fMode: TTunnelMode; {$IFDEF COMPRESS} {$IFDEF LZRW} fCompressor: TLZR; {$ENDIF} {$IFDEF BZIP2} fCompressor: TCompressor; {$ENDIF} {$ENDIF} fpCompBuffer: PChar; fpDeCompBuffer: PChar; fpEncrBuffer: PChar; fDSN: String; fUser: String; fKeyFile: String; fPassword: String; Locker: TCriticalSection; // Events fOnBeforeTunnelConnect: TSendTrnEventC; fOnTransformRead: TTunnelEventC; fOnInterpretMsg: TSendMsgEventC; fOnTransformSend: TSendTrnEventC; fOnStatus: TIdStatusEvent; // fOnTunnelDisconnect: TTunnelEvent; protected { Protected declarations } procedure DoBeforeTunnelConnect(var Header: TIdHeader; var CustomMsg: String); override; procedure DoTransformRead(Receiver: TReceiver); override; procedure DoInterpretMsg(var CustomMsg: String); override; procedure DoTransformSend(var Header: TIdHeader; var CustomMsg: String); override; procedure DoStatus(Sender: TComponent; const sMsg: String); override; procedure DoTunnelDisconnect(Thread: TSlaveThread); override; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; published { Published declarations } property Mode: TTunnelMode read fMode; // write SetMode; property DSN: String read fDSN write fDSN; property User: String read fUser write fUser; property KeyFile: String read fKeyFile write fKeyFile; property Password: String read fPassword write fPassword; property OnBeforeTunnelConnect: TSendTrnEventC read fOnBeforeTunnelConnect write fOnBeforeTunnelConnect; property OnTransformRead: TTunnelEventC read fOnTransformRead write fOnTransformRead; property OnInterpretMsg: TSendMsgEventC read fOnInterpretMsg write fOnInterpretMsg; property OnTransformSend: TSendTrnEventC read fOnTransformSend write fOnTransformSend; property OnStatus: TIdStatusEvent read FOnStatus write FOnStatus; end; procedure Register; implementation procedure Register; begin RegisterComponents('VPN', [TCryptedTunnelSlave]); RegisterComponents('VPN', [TCryptedTunnelMaster]); end; constructor TCryptedTunnelMaster.Create(AOwner: TComponent); begin inherited Create(AOwner); Locker := TCriticalSection.Create; end; destructor TCryptedTunnelMaster.Destroy; begin Locker.Free; inherited Destroy; end; procedure TCryptedTunnelMaster.GetUserList(var UserList: TStringList); var i: integer; list: TList; Thread: TIdPeerThread; tmpSlaveData: TSlaveUserData; s, t: String; begin List := Threads.LockList; try for i := Pred(list.Count) DownTo 0 do begin s := ''; Thread := TIdPeerThread(List[i]); s := 'A:' Thread.Connection.Binding.PeerIP ';'; s := s 'P:' IntToStr(Thread.Connection.Binding.PeerPort) ';'; tmpSlaveData := TSlaveUserData(TSlaveData(Thread.Data).UserData); if tmpSlaveData.fAuthorised then begin t := tmpSlaveData.fCryptor.m_checkUserID; s := s 'U:' t ';'; end else begin end; s := s 'I:' IntToStr(Thread.ThreadID) ';'; UserList.Add(s); end; finally Threads.UnlockList; end; end; procedure TCryptedTunnelMaster.KillUser(UserID: Integer); var i: integer; list: TList; Thread: TIdPeerThread; begin List := Threads.LockList; try for i := Pred(list.Count) DownTo 0 do begin Thread := TIdPeerThread(List[i]); if Thread.ThreadID = UserID then begin Thread.Connection.Disconnect; end; end; finally Threads.UnlockList; end; end; procedure TCryptedTunnelMaster.DoConnect(Thread: TIdPeerThread); var pDSN, pUser, pKeyFile, pPassword: array[0..200] of Char; begin inherited; StrPLCopy(pDSN, fDSN, 200); StrPLCopy(pUser, fUser, 200); StrPLCopy(pKeyFile, fKeyFile, 200); StrPLCopy(pPassword, fPassword, 200); TSlaveData(Thread.Data).UserData := TSlaveUserData.Create; with TSlaveUserData(TSlaveData(Thread.Data).UserData) do begin fClientAuthorised := True; . . . . fAddressAuthorised := True; end; {* if Assigned(fOnBeforeTunnelConnect) then fOnBeforeTunnelConnect(Header, CustomMsg); *} end; procedure TCryptedTunnelMaster.DoDisconnect(Thread: TIdPeerThread); begin with TSlaveUserData(TSlaveData(Thread.Data).UserData) do begin . . . .. . FreeMem(fpCompBuffer, BUFFERLEN); FreeMem(fpDeCompBuffer, BUFFERLEN); FreeMem(fpEncrBuffer, BUFFERLEN); end; {* if Assigned(OnDisconnect) then begin OnDisconnect(Thread); end; *} // Locker.Free; inherited; end; procedure TCryptedTunnelMaster.DoTransformRead(Thread: TIdPeerThread); var UserData: TSlaveUserData; User: TSlaveData; lenDeComp: Integer; lenEncr: Integer; status: Integer; begin // inherited; Locker.Enter; try User := TSlaveData(Thread.Data); UserData := TSlaveUserData(TSlaveData(Thread.Data).UserData); // kompresija enkripcija if User.Receiver.Header.MsgType = tmCustom then begin . . . . . end else begin try status := UserData.fCryptor.Decrypt(PCByte(User.Receiver.Msg), User.Receiver.MsgLen); if status < 0 then begin LogEvent('Error in decrypt: ' IntToStr(status)); User.Receiver.Header.MsgType := tmError; // signal the error end; . . . . except LogEvent('Except during read'); User.Receiver.Header.MsgType := tmError; // signal the error end; end; finally Locker.Leave; end; {* if Assigned(fOnTransformRead) then fOnTransformRead(Thread); *} end; procedure TCryptedTunnelMaster.DoTransformSend(Thread: TIdPeerThread; var Header: TIdHeader; var CustomMsg: String); var UserData: TSlaveUserData; lenComp: Integer; lenEncr: Integer; status: Integer; begin // inherited; Locker.Enter; try UserData := TSlaveUserData(TSlaveData(Thread.Data).UserData); if Header.MsgType = tmCustom then begin . . . end else begin try lenComp := UserData.fCompressor.Compression(BufferPtr(PChar(@CustomMsg[1])), BufferPtr(UserData.fpCompBuffer), Length(CustomMsg)); . . . except . . end; . . finally Locker.Leave; end; {* if Assigned(fOnTransformSend) then fOnTransformSend(Thread, Header, CustomMsg); *} end; procedure TCryptedTunnelMaster.DoInterpretMsg(Thread: TIdPeerThread; var CustomMsg: String); var UserData: TSlaveUserData; User: TSlaveData; statusS: Integer; lenEncr: Integer; begin // inherited; Locker.Enter; try User := TSlaveData(Thread.Data); UserData := TSlaveUserData(TSlaveData(Thread.Data).UserData); CustomMsg := ''; if not UserData.fAuthorised then begin statusS := UserData.fCryptor.SessionStage(PCBYTE(user.receiver.Msg), user.receiver.MsgLen, 111); . . . end; end; finally Locker.Leave; end; {* if Assigned(fOnInterpretMsg) then fOnInterpretMsg(Thread, CustomMsg); *} end; ///////////////////////////////////////////////////////////////////// constructor TCryptedTunnelSlave.Create(AOwner: TComponent); begin inherited Create(AOwner); fMode := stmDisconnected; fAuthorised := False; fbAcceptConnections := False; Locker := TCriticalSection.Create; {$IFDEF COMPRESS} {$IFDEF LZRW} fCompressor := TLZR.Create; {$ENDIF} {$IFDEF BZIP2} fCompressor := TCompressor.Create; {$ENDIF} {$ENDIF} GetMem(fpCompBuffer, BUFFERLEN); GetMem(fpDeCompBuffer, BUFFERLEN); GetMem(fpEncrBuffer, BUFFERLEN); end; destructor TCryptedTunnelSlave.Destroy; begin {$IFDEF COMPRESS} fCompressor.Destroy; {$ENDIF} FreeMem(fpCompBuffer, BUFFERLEN); FreeMem(fpDeCompBuffer, BUFFERLEN); FreeMem(fpEncrBuffer, BUFFERLEN); Locker.Free; inherited Destroy; end; procedure TCryptedTunnelSlave.DoBeforeTunnelConnect(var Header: TIdHeader; var CustomMsg: String); var lenEncr: Integer; pDSN, pUser, pKeyFile, pPassword: array[0..200] of Char; begin Locker.Enter; try fMode := stmConnecting; . . . finally Locker.Leave; end; {* inherited; if Assigned(fOnBeforeTunnelConnect) then fOnBeforeTunnelConnect(Header, CustomMsg); *} end; procedure TCryptedTunnelSlave.DoTransformRead(Receiver: TReceiver); var lenDeComp, statusC, lenEncr: Integer; //ratio: Real; begin Locker.Enter; try statusC := 0; if Receiver.Header.MsgType = tmCustom then begin . . end else begin try . . end; finally Locker.Leave; end; {* inherited; if Assigned(fOnTransformRead) then fOnTransformRead(Receiver); *} end; procedure TCryptedTunnelSlave.DoInterpretMsg(var CustomMsg: String); var statusC, lenEncr: Integer; //r: Real; begin Locker.Enter; try if not fAuthorised then begin try . . finally Locker.Leave; end; {* inherited; if Assigned(fOnInterpretMsg) then fOnInterpretMsg(CustomMsg); *} end; procedure TCryptedTunnelSlave.DoTransformSend(var Header: TIdHeader; var CustomMsg: String); var lenComp: Integer; lenEncr: Integer; status: Integer; begin Locker.Enter; try if Header.MsgType = tmCustom then begin . . . finally Locker.Leave; end; inherited; {* if Assigned(fOnTransformSend) then fOnTransformSend(Header, CustomMsg); *} end; procedure TCryptedTunnelSlave.DoStatus(Sender: TComponent; const sMsg: String); begin // inherited; // status is already trigered from the inherited procedure if Assigned(OnStatus) then OnStatus(self, hsText, sMsg); // end; procedure TCryptedTunnelSlave.DoTunnelDisconnect(Thread: TSlaveThread); begin inherited; try . . . finally end; end; end.--- Everything I say is a lie. |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |