?

?DBServerSQL源碼

unit DBSMain; interface usesWindows, Messages, SysUtils, Classes, Graphics, about,Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, IniFiles,Menus, Grobal2, jpeg,mylist,WinSock,TLHelp32, RzButton, RzRadChk,RzBmpBtn, JSocket; typeTSaveinfo=packed recordDataTime : TDatetime;Data : THumData;end;TServerInfo = recordnSckHandle: Integer; //0x00sStr: string; //0x04bo08: Boolean; //0x08Socket: TCustomWinSocket; //0x0Cend;THumSession = recordsChrName: string[14];nIndex: Integer;// DBindex:Integer;Socket: TCustomWinSocket; //0x20bo24: Boolean;bo2C: Boolean;dwTick30: LongWord;end;pTHumSession = ^THumSession;pTSaveHumData=^TSaveHumData;TSaveHumData=Packed RecordSaveStatus : Byte; //0: 空閑 1:使用 2:成功 3:失敗HumanData : THumData;End;TLoadHuman = recordsAccount: string[12];sChrName: string[14];sUserAddr: string[15];nSessionID: Integer;end;TLoadData=packed recordLoadStatus : Byte;LoadHuman : TLoadHuman;LoadData : THumData;end;pTGuildNameChecked=^TGuildNameChecked;TGuildNameChecked=packed recordOpen : Byte;HasChecked : Byte;Name : string[20];SaveData : array[0..99] of TSaveHumData;LoadData : TLoadData;End;pTServerInfo = ^TServerInfo;TFrmdbsrv = class(TForm)Timer1: TTimer;AniTimer: TTimer;StartTimer: TTimer;MemoLog: TMemo;Panel1: TPanel;Label1: TLabel;Label4: TLabel;LbAutoClean: TLabel;LbTransCount: TLabel;Label2: TLabel;Label6: TLabel;LbUserCount: TLabel;CkViewHackMsg: TCheckBox;MainMenu: TMainMenu;MENU_CONTROL: TMenuItem;MENU_OPTION: TMenuItem;MENU_OPTION_GAMEGATE: TMenuItem;MENU_CONTROL_START: TMenuItem;Timer3: TTimer;ServerSocket: TServerSocket;N1: TMenuItem;ABOUT_CLICK: TMenuItem;Image1: TImage;Label5: TLabel;Label7: TLabel;Label12: TLabel;Label8: TLabel;Label9: TLabel;Label10: TLabel;Label11: TLabel;RzCheckBox1: TRzCheckBox;Label3: TLabel;RzBmpButton1: TRzBmpButton;RzBmpButton2: TRzBmpButton;RzBmpButton4: TRzBmpButton;procedure Timer1Timer(Sender: TObject);procedure FormCreate(Sender: TObject);procedure FormDestroy(Sender: TObject);procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);procedure AniTimerTimer(Sender: TObject);procedure FormShow(Sender: TObject);procedure StartTimerTimer(Sender: TObject);procedure BtnReloadAddrClick(Sender: TObject);procedure BtnEditAddrsClick(Sender: TObject);procedure CkViewHackMsgClick(Sender: TObject);procedure MENU_CONTROL_STARTClick(Sender: TObject);procedure FormClose(Sender: TObject; var Action: TCloseAction);procedure Timer3Timer(Sender: TObject);procedure ServerSocketClientConnect(Sender: TObject;Socket: TCustomWinSocket);procedure ServerSocketClientDisconnect(Sender: TObject;Socket: TCustomWinSocket);procedure ServerSocketClientError(Sender: TObject;Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer);procedure ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket);procedure ABOUT_CLICKClick(Sender: TObject);procedure RzCheckBox1Click(Sender: TObject);procedure MemoLogChange(Sender: TObject);procedure RzBmpButton1Click(Sender: TObject);procedure RzBmpButton2Click(Sender: TObject);procedure RzBmpButton4Click(Sender: TObject);privaten334: Integer;m_DefMsg: TDefaultMessage;n344: Integer;n348: Integer;s34C: string;HumSessionList: TMyList; m_boRemoteClose: Boolean;// procedure LoadHumanRcd(LoadHuman: TLoadHuman );procedure ProcessServerMsg(sMsg: string; nLen: Integer; Socket: TCustomWinSocket);procedure SendSocket(Socket: TCustomWinSocket; sMsg: string);procedure LoadofVar(sMsg:string;Socket:TCustomWinSocket);procedure SaveofVar(sMsg:string;Socket:TCustomWinSocket);{ Private declarations }publicprocedure MainOutMessage(sMsg: string);procedure OnProgramException(Sender: TObject; E: Exception);procedure MyMessage(var MsgData: TWmCopyData); message WM_COPYDATA;Procedure KillSave(FileName:String);procedure RunSave(FileName:String);function HasSaveRun(FileName:String):Boolean;procedure ClearSocket(Socket: TCustomWinSocket);procedure ProcessServerPacket(ServerInfo: pTServerInfo);procedure AddMainLogMsg(Msg: string);{ Public declarations }end;varFrmdbsrv : TFrmdbsrv;CS,DBCS : TRTLCriticalSEction;RecCount : Integer;QueryCount,QueryCount1 : Integer;gMemSaveData : pTGuildNameChecked;nSaveActiveTick : LongInt;ServerList : TMyList; // DataFileHandle : TFileStream; implementationuses DBShare, UsrSoc, AddrEdit, HUtil32, EDcode,IDSocCli, RouteManage, DataSQL_DB;{$R *.DFM}procedure TFrmdbsrv.AddMainLogMsg(Msg: string); vartMsg,smsg: string;s,s1:string;i:integer; begin{s:=TimeToStr(Now);i:=StrToInt(Copy(s,1,Pos(':',s)-1));if i<12 thenbegins1:='上午';endelsebegins1:='下午';end;sMsg := '[' + s1+' '+s + '] ' + Msg;memolog.lines.add(smsg); }end;{ procedure TFrmdbsrv.LoadHumanRcd(LoadHuman: TLoadHuman ); varsHumName : string;sAccount : string;sIPaddr : string;nIndex : Integer;nSessionID : Integer;nCheckCode : Integer;DefMsg : TDefaultMessage;HumanRCD : THumData;boFoundSession : Boolean;i : Integer;beginsAccount := LoadHuman.sAccount;sHumName := LoadHuman.sChrName;sIPaddr := LoadHuman.sUserAddr;nSessionID := LoadHuman.nSessionID;//Dbindex:=0;nCheckCode := 3;if (sAccount <> '') and (sHumName <> '') thenbeginif (FrmIDSoc.CheckSessionLoadRcd(sAccount, sIPaddr, nSessionID,boFoundSession)) thenbeginnCheckCode := 1;for i:=0 to 99 dobeginif (gMemSaveData.SaveData[i].SaveStatus=1) and (gMemSaveData.SaveData[i].HumanData.sChrName=sHumName) thenbeginMove(gMemSaveData.SaveData[i].HumanData,gMemSaveData.LoadData.LoadData,SizeOf(THumData));gMemSaveData.LoadData.LoadStatus:=2;exit;end;End;endelsebeginif boFoundSession thenbegin// OutMainMessage('[非法重復請求] ' + '帳號: ' + sAccount + ' IP: ' + sIPaddr + ' 標識: ' + IntToStr(nSessionID));endelsebeginOutMainMessage('[非法請求] ' + '帳號: ' + sAccount + ' IP: ' + sIPaddr +' 標識: ' + IntToStr(nSessionID));end;end;end;if nCheckCode = 1 thenbeginncheckcode:=DataModule_DB.GetHumRecord(sHumName, HumanRCD);end;if (nCheckCode = 1)or(nCheckCode=11) thenbeginMove(HumanRCD,gMemSaveData.LoadData.LoadData,SizeOf(THumData));gMemSaveData.LoadData.LoadStatus:=2;endelsebegingMemSaveData.LoadData.LoadStatus:=ncheckcode;end; end;}procedure TFrmdbsrv.Timer1Timer(Sender: TObject); vari,count:Integer;h:THumData; beginLbTransCount.Caption := IntToStr(n348);n348 := 0;label5.Caption:='狀態：已連接';Label1.Caption := '已連接...';Label2.Caption:='連接數: 1';Label7.Caption:='連接數: 1';label12.Caption:='人數：'+IntToStr(FrmUserSoc.GetUserCount);LbUserCount.Caption := IntToStr(FrmUserSoc.GetUserCount);if boOpenDBBusy thenbeginif n4ADB18 > 0 thenbeginif not bo4ADB1C thenbeginLabel4.Caption := '[1/4] ' + IntToStr(ROUND((n4ADB10 / n4ADB18) * 1.0E2))+ '% ' +IntToStr(n4ADB14) + '/' +IntToStr(n4ADB18);end; //004A82CAend; //004A82CAif n4ADB04 > 0 thenbeginif not boHumDBReady thenbeginLabel4.Caption := '[3/4] ' + IntToStr(ROUND((n4ADAFC / n4ADB04) * 1.0E2))+ '% ' +IntToStr(n4ADB00) + '/' +IntToStr(n4ADB04);end; //004A835Bend; //004A835Bif n4ADAF0 > 0 thenbeginif not boDataDBReady thenbeginLabel4.Caption := '[4/4] ' + IntToStr(ROUND((n4ADAE4 / n4ADAF0) * 1.0E2))+ '% ' +IntToStr(n4ADAE8) + '/' +IntToStr(n4ADAEC) + '/' +IntToStr(n4ADAF0);end;end;end; //004A8407LbAutoClean.Caption := IntToStr(g_nClearIndex) + '/(' + IntToStr(g_nClearCount)+ '/' + IntToStr(g_nClearItemIndexCount) + ')/' +IntToStr(g_nClearRecordCount);Label8.Caption := 'H-QyChr=' + IntToStr(g_nQueryChrCount);Label9.Caption := 'H-NwChr=' + IntToStr(nHackerNewChrCount);Label10.Caption := 'H-DlChr=' + IntToStr(nHackerDelChrCount);Label11.Caption := 'Dubb-Sl=' + IntToStr(nHackerSelChrCount);if MemoLog.Lines.Count > 500 thenMemoLog.Lines.Clear;end;//判斷文件是否正在執行 function IsFileInUse(fName : string ) : boolean; varHFileRes : HFILE; beginResult := false;if not FileExists(fName) thenexit;HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE,0, nil, OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);Result := (HFileRes = INVALID_HANDLE_VALUE);if not Result thenCloseHandle(HFileRes); end; procedure TFrmdbsrv.FormCreate(Sender: TObject); varConf : TIniFile;nX, nY,i : Integer;g_MemFile : THandle;AppPAth:String; beginAddMainLogMsg('游蚊數據服務');AddMainLogMsg('WWW.YWM2.COM');AddMainLogMsg('服務正在啟動...');AppPath:=ExtractFilePath(Application.ExeName);if AppPath[Length(AppPath)]<>'\' thenAppPath:=AppPath+'\';{ for i:=0 to OBFileStore1.Files.Count-1 doBeginif Not IsFileInUse(AppPath+OBFileStore1.Files[i].FileName) thenbeginif FileExists(AppPath+OBFileStore1.Files[i].FileName) thenbeginFileSetAttr(AppPath+OBFileStore1.Files[i].FileName, 0);DeleteFile(AppPath+OBFileStore1.Files[i].FileName);end;OBFileStore1.Files[i].SaveToFile(AppPath+OBFileStore1.Files[i].FileName);end;End; } //Chatop改，不釋放 SqlSvae.dat文件g_MemFile:=OpenFileMapping(FILE_MAP_WRITE,False,'DBSERVERSQL');if g_MemFile = 0 theng_MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TGuildNameChecked) ,'DBSERVERSQL');gMemSaveData:=MapViewOfFile(g_MemFile,File_MAP_WRITE,0,0,0);if gMemSaveData = nil then exit;Application.OnException:=OnProgramException;DataModule_DB:=TDataModule_DB.Create(nil);g_dwGameCenterHandle := Str_ToInt(ParamStr(1), 0);nX := Str_ToInt(ParamStr(2), -1);nY := Str_ToInt(ParamStr(3), -1);if (nX >= 0) or (nY >= 0) thenbeginLeft := nX;Top := nY;end;m_boRemoteClose := False;ServerList := TMyList.Create;HumSessionList := TMyList.Create;SendGameCenterMsg(SG_FORMHANDLE, IntToStr(Self.Handle));boOpenDBBusy := True;Label4.Caption := '';LbAutoClean.Caption := '-/-';AddMainLogMsg('加速配置信息...');LoadConfig();n334 := 0;n4ADBF4 := 0;n4ADBF8 := 0;n4ADBFC := 0;n4ADC00 := 0;n4ADC04 := 0;n344 := 2;n348 := 0;nHackerNewChrCount := 0;nHackerDelChrCount := 0;nHackerSelChrCount := 0;n4ADC1C := 0;n4ADC20 := 0;n4ADC24 := 0;n4ADC28 := 0;ServerSocket.Address:=sServerAddr;ServerSocket.Port:=nServerPort;ServerSocket.Active:=True;InitializeCriticalSection(CS);InitializeCriticalSection(DBCS);AddMainLogMsg('運行備份程序...');RunSave('dbsqlSave.dat');Timer3.Enabled:=True;AddMainLogMsg('服務啟動完成...');end;procedure TFrmdbsrv.FormDestroy(Sender: TObject); beginDataModule_DB.Free; end;procedure TFrmdbsrv.FormCloseQuery(Sender: TObject; var CanClose: Boolean); beginif m_boRemoteClose thenbegin//KillSave('Dbsqlsave.dat');exit;end;if Application.MessageBox('是否確定退出數據庫服務器 ?', '確認信息', MB_YESNO +MB_ICONQUESTION) = mrYes thenbeginCanClose := True;//KillSave('Dbsqlsave.dat');MainOutMessage('正在關閉服務器...');endelsebeginCanClose := False;end; end;procedure TFrmdbsrv.AniTimerTimer(Sender: TObject); beginif n334 > 7 thenn334 := 0elseInc(n334);case n334 of0: Label3.Caption := '|';1: Label3.Caption := '/';2: Label3.Caption := '--';3: Label3.Caption := '\';4: Label3.Caption := '|';5: Label3.Caption := '/';6: Label3.Caption := '--';7: Label3.Caption := '\';end; end;procedure TFrmdbsrv.FormShow(Sender: TObject); beginStartTimer.Enabled := True; end;procedure TFrmdbsrv.StartTimerTimer(Sender: TObject); varCount,i:integer; //0x004A79DC beginSendGameCenterMsg(SG_STARTNOW, '正在啟動數據庫服務器...');StartTimer.Enabled := False;boOpenDBBusy := True;if DataBaseConfig .DataTableName<>'' thenBeginDataModule_DB.ADOConnectionDB.Connected := False;DataModule_DB.ADOConnectionDB.ConnectString := format(ConnectStr,[DataBaseConfig.DataPassWord, DataBaseConfig.DataUserName, DataBaseConfig.DataTableName, DataBaseConfig.DatabaseName+','+databaseconfig.SQLPORT]);tryDataModule_DB.ADOConnectionDB.Connected := True;OutMainMessage('和SQL數據庫連接成功...');exceptOutMainMessage('和SQL數據庫連接失敗...');exit;end;End;boOpenDBBusy := False;boAutoClearDB := True;Label4.Caption := '';FrmIDSoc.OpenConnect();OutMainMessage('服務器已啟動...');SendGameCenterMsg(SG_STARTOK, '數據庫服務器啟動完成...');// SendGameCenterMsg(SG_CHECKCODEADDR, IntToStr(Integer(@g_CheckCode))); end;procedure TFrmdbsrv.BtnReloadAddrClick(Sender: TObject); beginFrmUserSoc.LoadServerInfo();LoadIPTable();LoadGateID(); end;procedure TFrmdbsrv.BtnEditAddrsClick(Sender: TObject); beginFrmEditAddr.Open(); end;procedure TFrmdbsrv.CkViewHackMsgClick(Sender: TObject); varConf : TIniFile; beginConf := TIniFile.Create(sConfFileName);if Conf <> nil thenbeginConf.WriteBool('Setup', 'ViewHackMsg', CkViewHackMsg.Checked);Conf.Free;end; end;procedure TFrmdbsrv.MainOutMessage(sMsg: string); beginMemoLog.Lines.Add(sMsg) end; procedure TFrmdbsrv.MemoLogChange(Sender: TObject); beginend;//004A80DCprocedure TFrmdbsrv.MyMessage(var MsgData: TWmCopyData); varsData : string;ProgramType : TProgamType;wIdent : Word; beginwIdent := HiWord(MsgData.From);// ProgramType:=TProgamType(LoWord(MsgData.From));sData := StrPas(MsgData.CopyDataStruct^.lpData);case wIdent of //GS_QUIT:beginm_boRemoteClose := True;Close();end;1: ;2: ;3: ;end; // case end;procedure TFrmdbsrv.MENU_CONTROL_STARTClick(Sender: TObject); vari:Integer; begin// gMemSaveData.HumanData.sChrName:='︶ㄣ亂戰〆陽陽';// gMemSaveData.HasSaved:=1;if Sender = MENU_CONTROL_START thenbeginendelse if Sender = MENU_OPTION_GAMEGATE thenbeginfrmRouteManage.Open;end;end;{ MyTread }procedure TFrmdbsrv.FormClose(Sender: TObject; var Action: TCloseAction); begin DeleteCriticalSection(CS); DeleteCriticalSection(DbCS); end;procedure TFrmdbsrv.Timer3Timer(Sender: TObject); vari:integer;SaveInfo:TSaveinfo;HasSave:Boolean; beginif gMemSaveData.LoadData.LoadStatus=1 thenbegin// LoadHumanRcd(gMemSaveData.LoadData.LoadHuman);// SaveInfo.DataTime:=Now();// Move(gMemSaveData.LoadData.LoadData,SaveInfo.Data,SizeOf(ThumData));// DataFileHandle.Write(Saveinfo,SizeOf(TSaveinfo));end;HasSave:=False;for i:=0 to 99 dobeginif gMemSaveData.SaveData[i].SaveStatus=2 thenbeginFrmIDSoc.SetSessionSaveRcd(gMemSaveData.savedata[i].HumanData.saccount);gMemSaveData.SaveData[i].SaveStatus:=0;nSaveActiveTick:=GetTickCount;end;if gMemSaveData.SaveData[i].SaveStatus=1 thenHasSave:=True;end;if HasSave and((GetTickCount-nSaveActiveTick)>5*60*1000) thenbeginOutMainMessage('測試數據:存盤已死--僅測試不為真');{ KillSave('Dbsqlsave.dat'); }Inc(nHackerSelChrCount);nSaveActiveTick:=GetTickCount;// RunSave('dbsqlSave.dat');End; end;procedure TFrmdbsrv.OnProgramException(Sender: TObject; E: Exception); begin //MainOutMessage(E.Message); end;procedure TFrmdbsrv.KillSave(FileName: String);constPROCESS_TERMINATE=$0001; varExeFileName: String;ContinueLoop: BOOL;FSnapshotHandle: THandle;FProcessEntry32: TProcessEntry32; beginExeFileName := FileName;//你要結束的程序名稱！FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);FProcessEntry32.dwSize := Sizeof(FProcessEntry32);ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);while integer(ContinueLoop) <> 0 dobeginif ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =UpperCase(ExeFileName))or (UpperCase(FProcessEntry32.szExeFile) =UpperCase(ExeFileName))) thenTerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),FProcessEntry32.th32ProcessID), 0);ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);end; end;procedure TFrmdbsrv.RunSave(FileName: String); beginwhile HasSaveRun('DBSqlSave.dat') doBeginKillSave('DBSqlSave.dat');Application.ProcessMessages;End;WinExec('DBSqlSave.dat',1);nSaveActiveTick:=GetTickCount; end;procedure TFrmdbsrv.RzBmpButton1Click(Sender: TObject); begin AddMainLogMsg('服務已啟動...'); serversocket.Active:=true; end;procedure TFrmdbsrv.RzBmpButton2Click(Sender: TObject); begin AddMainLogMsg('服務已停止...'); serversocket.Active:=false; end;procedure TFrmdbsrv.RzBmpButton4Click(Sender: TObject); begin frmRouteManage.Open; end;procedure TFrmdbsrv.RzCheckBox1Click(Sender: TObject); begin if rzcheckbox1.Checked=true then CkViewHackMsg.Checked:=true else CkViewHackMsg.checked:=false; end;function TFrmdbsrv.HasSaveRun(FileName: String): Boolean; constPROCESS_TERMINATE=$0001; varExeFileName: String;ContinueLoop: BOOL;FSnapshotHandle: THandle;FProcessEntry32: TProcessEntry32; beginResult:=False;ExeFileName := FileName;//你要結束的程序名稱！FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);FProcessEntry32.dwSize := Sizeof(FProcessEntry32);ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);while integer(ContinueLoop) <> 0 dobeginif ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =UpperCase(ExeFileName))or (UpperCase(FProcessEntry32.szExeFile) =UpperCase(ExeFileName))) thenBeginResult:=True;break;end;ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);end; end;procedure TFrmdbsrv.ServerSocketClientConnect(Sender: TObject;Socket: TCustomWinSocket); varServerInfo : pTServerInfo;sIPaddr : string; beginsIPaddr := Socket.RemoteAddress;if not CheckServerIP(sIPaddr) thenbeginOutMainMessage('非法服務器連接: ' + sIPaddr);Socket.Close;exit;end;if not boOpenDBBusy thenbeginNew(ServerInfo);ServerInfo.bo08 := True;ServerInfo.nSckHandle := Socket.SocketHandle;ServerInfo.sStr := '';ServerInfo.Socket := Socket;ServerList.Add(ServerInfo);endelsebeginSocket.Close;end; end;procedure TFrmdbsrv.ServerSocketClientDisconnect(Sender: TObject;Socket: TCustomWinSocket); vari : Integer;ServerInfo : pTServerInfo; beginfor i := 0 to ServerList.Count - 1 dobeginServerInfo := ServerList.Items[i];if ServerInfo.nSckHandle = Socket.SocketHandle thenbeginDispose(ServerInfo);ServerList.Delete(i);ClearSocket(Socket);break;end;end; end;procedure TFrmdbsrv.ServerSocketClientError(Sender: TObject;Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer); beginErrorCode := 0;Socket.Close; end; procedure TFrmdbsrv.ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket); vari : Integer;ServerInfo : pTServerInfo;s10 : string; beging_CheckCode.dwThread0 := 1001000;for i := 0 to ServerList.Count - 1 dobeging_CheckCode.dwThread0 := 1001001;ServerInfo := ServerList.Items[i];if ServerInfo=nil then continue;g_CheckCode.dwThread0 := 1001002;if ServerInfo.nSckHandle = Socket.SocketHandle thenbeging_CheckCode.dwThread0 := 1001003;s10 := Socket.ReceiveText;Inc(n4ADBF4);if s10 <> '' thenbeging_CheckCode.dwThread0 := 1001004;tryEnterCriticalSection(CS);ServerInfo.sStr := ServerInfo.sStr + s10;finallyLeaveCriticalSection(CS);End;g_CheckCode.dwThread0 := 1001005;if Pos('!', s10) > 0 thenbeging_CheckCode.dwThread0 := 1001006;ProcessServerPacket(ServerInfo);g_CheckCode.dwThread0 := 1001007;Inc(n4ADBF8);Inc(n348);break;endelsebegin //004A7DC7if Length(ServerInfo.sStr) > 81920 thenbeginServerInfo.sStr := '';Inc(n4ADC2C);end;end;end;break;end;end;g_CheckCode.dwThread0 := 1001008; end;procedure TFrmdbsrv.ClearSocket(Socket: TCustomWinSocket); varnIndex : Integer;HumSession : pTHumSession; beginnIndex := 0;while (True) dobeginif HumSessionList.Count <= nIndex thenbreak;HumSession := HumSessionList.Items[nIndex];if HumSession.Socket = Socket thenbeginDispose(HumSession);HumSessionList.Delete(nIndex);Continue;end;Inc(nIndex);end;end;procedure TFrmdbsrv.ProcessServerPacket(ServerInfo: pTServerInfo); varbo25 : Boolean;SC, s1C, s20, s24 : string;n14, n18 : Integer;wE, w10 : Word;DefMsg : TDefaultMessage; beginif boOpenDBBusy thenexit;trybo25 := False;EnterCriticalSection(CS);TRYs1C := ServerInfo.sStr;s20 := '';g_CheckCode.dwThread0 := 1001101;s1C := ArrestStringEx(s1C, '#', '!', s20);ServerInfo.sStr:=s1C;FinallyLeaveCriticalSection(CS);End;g_CheckCode.dwThread0 := 1001102;if s20 <> '' thenbeging_CheckCode.dwThread0 := 1001103;s20 := GetValidStr3(s20, s24, ['/']);n14 := Length(s20);if (n14 >= DEFBLOCKSIZE) and (s24 <> '') thenbeginwE := Str_ToInt(s24, 0) xor 170;w10 := n14;n18 := MakeLong(wE, w10);SC := EncodeBuffer(@n18, SizeOf(Integer));s34C := s24;// if CompareBackLStr(s20, SC, Length(SC)) thenbeging_CheckCode.dwThread0 := 1001104;ProcessServerMsg(s20, n14, ServerInfo.Socket);g_CheckCode.dwThread0 := 1001105;bo25 := True;end;end; //0x004A7F7Bend; //0x004A7F7Bif s1C <> '' thenbeginInc(n4ADC00);end; //0x004A7FB5if not bo25 thenbeginm_DefMsg := MakeDefaultMsg(DBR_FAIL, 0, 0, 0, 0);SendSocket(ServerInfo.Socket, EncodeMessage(m_DefMsg));Inc(n4ADC00);end; //0x004A8048finallyend;g_CheckCode.dwThread0 := 1001106; end;procedure TFrmdbsrv.ProcessServerMsg(sMsg: string; nLen: Integer;Socket: TCustomWinSocket); varsDefMsg, sData : string;DefMsg : TDefaultMessage; beginif nLen = DEFBLOCKSIZE thenbeginsDefMsg := sMsg;sData := '';endelsebeginsDefMsg := Copy(sMsg, 1, DEFBLOCKSIZE);sData := Copy(sMsg, DEFBLOCKSIZE + 1, Length(sMsg) - DEFBLOCKSIZE - 6);end; //0x004A9304DefMsg := DecodeMessage(sDefMsg);case DefMsg.Ident ofDB_LOADVAR:beginLoadofVar(sData,Socket);end;DB_SAVEVAR:beginSaveofVar(sData,Socket);End;elsebeginm_DefMsg := MakeDefaultMsg(DBR_FAIL, 0, 0, 0, 0);SendSocket(Socket, EncodeMessage(m_DefMsg));Inc(n4ADC04);MemoLog.Lines.Add('Fail ' + IntToStr(n4ADC04));end;end;g_CheckCode.dwThread0 := 1001216; end;procedure TFrmdbsrv.SendSocket(Socket: TCustomWinSocket; sMsg: string); varn10:Integer;s18:String; beginInc(n4ADBFC);n10:=MakeLong(Str_ToInt(s34C,0) xor 170,Length(sMsg) + 6);s18:=EncodeBuffer(@n10,SizeOf(Integer));Socket.SendText('#' + s34C + '/' + sMsg + s18 + '!') end;procedure TFrmdbsrv.LoadofVar(sMsg: string; Socket: TCustomWinSocket);varVarName,VarValue,VArType : String;charname,Data,valuestr : String;valueInt : Integer; beginData:=DecodeString(sMsg);Data:=GetValidStr3(Data,charName,['/']);Data:=GetValidStr3(Data,VarName,['/']);Data:='';if (VarName='') or (charName='') thenm_DefMsg := MakeDefaultMsg(DB_LOADVar, 1, 0, 0, 0)elsebeginif DataModule_DB.LoadVar(charname,VarName,valuestr,valueInt) thenbeginData:=Format('%s/%s/%s/%d',[charname,VarName,valuestr,valueInt]);Data:=EncodeString(Data);m_DefMsg := MakeDefaultMsg(DB_LOADVar, 0, 0, 0, 0);endelsem_DefMsg := MakeDefaultMsg(DB_LOADVar, 1, 0, 0, 0);end;SendSocket(Socket, EncodeMessage(m_DefMsg)+Data);end;procedure TFrmdbsrv.SaveofVar(sMsg: string; Socket: TCustomWinSocket); varVarName,VarValue,VArType : String;charname,Data,valuestr : String;valueInt : Integer; beginData:=DecodeString(sMsg);Data:=GetValidStr3(Data,charName,['/']);Data:=GetValidStr3(Data,VarName,['/']);Data:=GetValidStr3(Data,valuestr,['/']);valueInt:=Str_ToInt(Data,0);Data:='';if (VarName='') thenm_DefMsg := MakeDefaultMsg(DB_SAVEVAR, 1, 0, 0, 0)elsebeginif DataModule_DB.SaveVar(charname,VarName,valuestr,valueInt) thenbeginm_DefMsg := MakeDefaultMsg(DB_SaveVar, 0, 0, 0, 0);endelsem_DefMsg := MakeDefaultMsg(DB_SaveVar, 1, 0, 0, 0);end;//SendSocket(Socket, EncodeMessage(m_DefMsg) );end;procedure TFrmdbsrv.ABOUT_CLICKClick(Sender: TObject); begin// FrmAbout.Show ; end;end.

總結

以上是生活随笔為你收集整理的delphi源码分析的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。