fmain.pas

千年源代码,只缺少控件,可以做二次开发用,好不容易得来的

   end;
end;

procedure TfrmMain.sckRemoteAcceptClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   RemoteConnectorList.SetWriteAllow (Socket);
end;

procedure TfrmMain.sckAcceptAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   ConnectorList.CreateConnect (Socket);
   AddLog (format ('Gate Server Accepted %s', [Socket.RemoteAddress]));
end;

procedure TfrmMain.sckAcceptClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   //
end;

procedure TfrmMain.sckAcceptClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   ConnectorList.DeleteConnect (Socket);
   AddLog (format ('Gate Server Disconnected %s', [Socket.RemoteAddress]));
end;

procedure TfrmMain.sckAcceptClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   AddLog (format ('Gate Server Accept Socket Error (%d, %s)', [ErrorCode, Socket.RemoteAddress]));
   ErrorCode := 0;
end;

procedure TfrmMain.sckAcceptClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   nRead : Integer;
   buffer : array[0..4096] of byte;
begin
   nRead := Socket.ReceiveBuf (buffer, 4096);
   if nRead > 0 then begin
      ConnectorList.AddReceiveData (Socket, @buffer, nRead);
      exit;
   end;
end;

procedure TfrmMain.sckAcceptClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   ConnectorList.SetWriteAllow (Socket);
end;

procedure TfrmMain.cmdAddRecordClick(Sender: TObject);
var
   mStr : String;
   nCount : Integer;
begin
   mStr := InputBox ('单捞鸥海捞胶 犬厘', '单捞鸥海捞胶 犬厘农扁(饭内靛扒荐)', '0');
   nCount := _StrToInt (mStr);
   if nCount <= 0 then exit;

   DBProvider.AddBlankRecord (nCount);
end;

procedure TfrmMain.timerDisplayTimer(Sender: TObject);
var
   CurTick : Integer;
   FileName : String;
   nYear, nMonth, nDay : Word;
   mYear, mMonth, mDay : Word;
begin
   CurTick := timeGetTime;

   if CurTick >= StartTick + 1000 then begin
      ElaspedSec := ElaspedSec + 1;
      StartTick := CurTick;
   end;

   lblElaspedTime.Caption := IntToStr (ElaspedSec);
   lblTotalRecordCount.Caption := IntToStr (DBProvider.TotalRecordCount);
   lblUsedRecordCount.Caption := IntToStr (DBProvider.UsedRecordCount);
   lblUnusedRecordCount.Caption := IntToStr (DBProvider.UnusedRecordCount);
   lblGateConnectCount.Caption := IntToStr (ConnectorList.Count);
   lblRemoteConnectCount.Caption := IntToStr (RemoteConnectorList.Count);
   lblLockedCount.Caption := IntToStr (CurrentCharList.Count);

   if TodayDate <> Date then begin
      DecodeDate (TodayDate, nYear, nMonth, nDay);
      DecodeDate (Date, mYear, mMonth, mDay);

      FileName := '.\UserData\UserData';
      FileName := FileName + IntToStr (nYear) + '-';
      if nMonth < 10 then FileName := FileName + '0' + IntToStr (nMonth) + '-'
      else FileName := FileName + IntToStr (nMonth) + '-';
      if nDay < 10 then FileName := FileName + '0' + IntToStr (nDay) + '.SDB'
      else FileName := FileName + IntToStr (nDay) + '.SDB';

      SaveTodayData (FileName);
      TodayCharList.Clear;
      TodayDate := Date;
      if nMonth <> mMonth then BackupFDB;
   end;
end;

procedure TfrmMain.timerProcessTimer(Sender: TObject);
var
   CurTick : Integer;
begin
   CurTick := timeGetTime;
   ConnectorList.Update (CurTick);
   RemoteConnectorList.Update (CurTick);

   if boBackup = true then begin
      if DBProvider.BackupRecord (BackupStream, BackupPos) = false then begin
         BackupStream.Free;
         BackupStream := nil;
         BackupPos := 0;
         boBackup := false;

         cmdBackup.Enabled := true;
         cmdClose.Enabled := true;
         Caption := 'DB Server';
         exit;
      end;
      BackupPos := BackupPos + 1;
      Caption := 'Backup : ' + IntToStr (BackupPos);
   end;
end;

function TfrmMain.GetUserDataFields : String;
var
   i : Integer;
   RetStr : String;
begin
   RetStr := 'PrimaryKey,MasterName,Guild,LastDate,CreateDate,Sex,ServerId,X,Y';
   RetStr := RetStr + ',Light,Dark,Energy,InPower,OutPower,Magic,Life,Talent,GoodChar';
   RetStr := RetStr + ',BadChar,Adaptive,Revival,Immunity,Virtue,CurEnergy,CurInPower';
   RetStr := RetStr + ',CurOutPower,CurMagic,CurLife,CurHealth,CurSatiety,CurPoisoning';
   RetStr := RetStr + ',CurHeadSeak,CurArmSeak,CurLegSeak';
   for i := 0 to 10 - 1 do begin
      RetStr := RetStr + format (',BasicMagic%d', [i]);
   end;
   for i := 0 to 8 - 1 do begin
      RetStr := RetStr + format (',WearItem%d', [i]);
   end;
   for i := 0 to 30 - 1 do begin
      RetStr := RetStr + format (',HaveItem%d', [i]);
   end;
   for i := 0 to 30 - 1 do begin
      RetStr := RetStr + format (',HaveMagic%d', [i]);
   end;

   Result := RetStr;
end;

function TfrmMain.GetItemDataFields : String;
var
   i : Integer;
   RetStr : String;
begin
   RetStr := 'Name,No,Password';
   for i := 0 to 10 - 1 do begin
      RetStr := RetStr + format (',Item%d', [i]);
   end;
   Result := RetStr;
end;


procedure TfrmMain.AddTodayData (KeyValue, aStr : String);
var
   i : Integer;
   str, rdstr : String;
begin
   for i := 0 to TodayCharList.Count - 1 do begin
      str := TodayCharList.Strings [i];
      str := GetTokenStr (str, rdstr, ',');
      if rdstr = KeyValue then begin
         TodayCharList.Strings [i] := aStr;
         exit;
      end;
   end;
   TodayCharList.Add (aStr);
end;

procedure TfrmMain.SaveTodayData (aFileName : String);
var
   FileName : String;
   mStr : String;
   boClear : Boolean;
begin
   if TodayCharList.Count = 0 then exit;

   if aFileName = '' then begin
      FileName := '.\UserData\Today.SDB';
      boClear := false;
   end else begin
      FileName := afileName;
      boClear := true;
   end;
   if FileExists (FileName) then begin
      DeleteFile (FileName);
   end;

   mStr := GetUserDataFields;
   TodayCharList.Insert (0, mStr);
   TodayCharList.SaveToFile (FileName);
   TodayCharList.Delete (0);

   if boClear = true then begin
      TodayCharList.Clear;
   end;
end;

procedure TfrmMain.cmdSaveUserDataClick(Sender: TObject);
begin
   SaveTodayData ('');
end;

procedure TfrmMain.cmdBackupClick(Sender: TObject);
begin
   if Application.MessageBox ('Do you want to backup fdb file?', 'DB SERVER', MB_OKCANCEL) <> ID_OK then exit;

   BackupFDB;
end;

function TfrmMain.BackupFDB;
var
   FileName : String;
   mYear, mMonth, mDay : Word;
begin
   DecodeDate (Date, mYear, mMonth, mDay);
   if BackupStream <> nil then BackupStream.Free;
   FileName := format ('.\UserData\Backup%d-%d-%d.FDB', [mYear, mMonth, mDay]);
   if FileExists (FileName) then DeleteFile (FileName);
   BackupStream := TFileStream.Create (FileName, fmCreate);
   DBProvider.BackupHeader (BackupStream);

   boBackup := true;
   BackupPos := 0;

   cmdBackup.Enabled := false;
   cmdClose.Enabled := false;
end;

procedure TfrmMain.sckItemRemoteAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   RemoteConnectorList.CreateConnect (Socket, rt_itemdata);
   AddEvent ('ItemRemote Accepted ' + Socket.RemoteAddress);
end;

procedure TfrmMain.sckItemRemoteClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   RemoteConnectorList.DeleteConnect (Socket);
   AddEvent ('ItemRemote DisConnected ' + Socket.RemoteAddress);
end;

procedure TfrmMain.sckItemRemoteClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   ErrorCode := 0;
end;

procedure TfrmMain.sckItemRemoteClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   cmdStr : String;
begin
   if Socket.ReceiveLength > 0 then begin
      cmdStr := Socket.ReceiveText;
      RemoteConnectorList.AddReceiveData (Socket, cmdStr);
   end;
end;

procedure TfrmMain.sckItemRemoteClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   RemoteConnectorList.SetWriteAllow (Socket);
end;

end.