server.pas

网吧商品销售平台

unit server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSkinData, Menus, RzTray, ComCtrls, ExtCtrls,about,setup,inifiles
  ,sale, IdTCPServer, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient,
  Sockets,math, StdCtrls,mess,saleout, IdAntiFreezeBase, IdAntiFreeze,
  IdTCPConnection, IdTCPClient, IdHTTP,update1;

type
  TServerForm = class(TForm)
    MainMenu1: TMainMenu;
    SkinData1: TSkinData;
    F1: TMenuItem;
    O1: TMenuItem;
    H1: TMenuItem;
    A1: TMenuItem;
    X1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    A2: TMenuItem;
    D1: TMenuItem;
    E1: TMenuItem;
    TrayIcon1: TRzTrayIcon;
    PopupMenu1: TPopupMenu;
    X2: TMenuItem;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    Panel2: TPanel;
    PageControl1: TPageControl;
    ShopsTab: TTabSheet;
    ClientTab: TTabSheet;
    ListView2: TListView;
    ListView3: TListView;
    Panel4: TPanel;
    N4: TMenuItem;
    N5: TMenuItem;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    ListView1: TListView;
    Panel3: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    ListView4: TListView;
    PopupMenu2: TPopupMenu;
    A3: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    S3: TMenuItem;
    N9: TMenuItem;
    S4: TMenuItem;
    Timer1: TTimer;
    IdTCPServer1: TIdTCPServer;
    MesTCPServer: TIdTCPServer;
    U1: TMenuItem;
    N10: TMenuItem;
    Timer2: TTimer;
    IdHTTP: TIdHTTP;
    AntiFreeze: TIdAntiFreeze;
    procedure X1Click(Sender: TObject);
    procedure S2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure A1Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure ListView3DblClick(Sender: TObject);
    procedure O1Click(Sender: TObject);
    procedure ListView1ContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure A3Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure S3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure MesTCPServerExecute(AThread: TIdPeerThread);
    procedure FormDestroy(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure ListView2Click(Sender: TObject);
    procedure ListView4DblClick(Sender: TObject);
    procedure U1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ServerForm: TServerForm;
  SendFileStream:TFileStream;
  messagecount:integer;

implementation

{$R *.dfm}

uses MMSystem;

function GetFileVersion(FileName: String):string;  //取得文件版本
var
  InfoSize, unuse: DWORD;
  VerBuf: Pointer;
  FI: PVSFixedFileInfo;
  VerSize: DWORD;
  MajorMinor,ReleaseBuild :DWORD;
begin
  unuse :=0;
  MajorMinor := 0;//Major,Minor 如：00010001代表1.1
  ReleaseBuild := 0;//Release,Build 如00121208代表12.1208 则版本为1.1.12.1208
  result :='unknown';
  InfoSize := GetFileVersionInfoSize(PChar(FileName), unuse);
  if InfoSize <> 0 then
  begin
  GetMem(VerBuf, InfoSize);
  try
  if GetFileVersionInfo(PChar(FileName), unuse, InfoSize, VerBuf) then
  if VerQueryvalue(VerBuf,'\', Pointer(FI), VerSize) then
  begin
    MajorMinor := FI.dwFileVersionMS;
    ReleaseBuild := FI.dwFileVersionLS;
  end;
  finally
  FreeMem(VerBuf);
  end;
  result :=IntToStr(MajorMinor shr 16) +'.' + IntToStr(MajorMinor and $ffff) +'.' + IntToStr(ReleaseBuild shr 16) +'.' + IntToStr(ReleaseBuild and $ffff);
  end;
end;

function NeedUpdate():Bool;
var   i:integer;
      g_path:string;
      url:string;
      myini:Tinifile;
      s: TStringlist;
      NewVersion,OldVersion:string;
      HTTPFile:TIdHTTP;
begin
  result:=false;
  try
  url:='http://www.zt123.net/saleserver/ver.txt';   //要升级的服务器
  g_path:=ExtractFilePath(application.ExeName);   //升级程序的路径
  //下载升级信息文件
  if not DirectoryExists(g_path+'Update') then mkdir('Update');
  ServerForm.AntiFreeze.OnlyWhenIdle:=False;
  HTTPFile:=TIdHTTP.Create(nil);
  HTTPFile.ReadTimeout := 2000; //此处是用来限制得到服务器列表所用的时间,用处请自行研究,本人认为1500左右较好
    s := TStringlist.Create;
    s.Clear;
    s.Add(HTTPFile.Get(url));    //读取配置文件
    s.SaveToFile(Pchar(g_path+'update\update.ver'));
    s.Free;
  HTTPFile.Free;
  if FileExists(g_path+'update\update.ver') then
  begin
  try
  myini:=Tinifile.Create(g_path+'update\update.ver');
  NewVersion:=myini.ReadString('update','version',GetFileVersion(application.ExeName));
  OldVersion:=GetFileVersion(application.ExeName);
  if trim(OldVersion)=trim(NewVersion) then Result:=False
  else Result:=True;
  finally
  myini.free;
  end;
  end;
  except
  result:=false;   //取得升级信息出错！，不用再继续
  exit;
  end;
end;

procedure ClearMemory;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
Application.ProcessMessages;
end;
end;

function ShowMessageForm(var Mes:string;var IP:string):Bool;
var receiveform:treceiveform;
    Computername,mes_clean,ClientIP:String;
    myini:Tinifile;
begin
try
ClientIP:=IP;
computername:=mes;
mes_clean:=mes;
setlength(computername,10);
Delete(computername,1,1);
computername:=trim(computername);
Delete(mes_clean,1,10);
mes_clean:=trim(mes_clean);
messagecount:=messagecount+1;
myini:=Tinifile.Create(ExtractFilePath(paramstr(0))+'log.txt');
myini.WriteString(computername,'content'+inttostr(messagecount),mes_clean);
myini.WriteString(computername,'fromip'+inttostr(messagecount),ClientIP);
myini.WriteDate(computername,'date'+inttostr(messagecount),date());
myini.WriteTime(computername,'time'+inttostr(messagecount),time());
myini.Free;
ServerForm.Timer2.Enabled:=True;
receiveform:=treceiveform.create(nil);
receiveform.memo1.clear;
receiveform.Memo1.Lines.Add('【'+DateTimeToStr(now())+'】'+chr(10)+chr(13)+chr(10)+chr(13));
receiveform.Memo1.Lines.Add('『'+computername+'』'+'：'+mes_clean);
receiveform.Showmodal;
finally
receiveform.Free;
end;
result:=True;
end;

procedure TServerForm.X1Click(Sender: TObject);
begin
if application.MessageBox('退出服务端下面将无法连接，确定吗？','询问',MB_ICONQUESTION+MB_YESNO)=IDYES then
begin
if FileExists(ExtractFilePath(paramstr(0))+'ZTD.TMP') then DeleteFile(ExtractFilePath(paramstr(0))+'ZTD.TMP');
sleep(500);
application.Terminate;
end;
end;

procedure TServerForm.S2Click(Sender: TObject);
begin
ServerForm.Show;
end;

procedure TServerForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caNone;
application.Minimize;
end;

procedure TServerForm.A1Click(Sender: TObject);
var aboutform:Taboutform;
begin
try
aboutform:=Taboutform.Create(self);
aboutform.Label3.Caption:='版本：'+GetFileVersion(application.ExeName)+' [Build 2008.07.03]';
aboutform.ShowModal;
finally
aboutform.Free;
end;
end;

procedure TServerForm.N5Click(Sender: TObject);
var setupform:Tsetupform;
    myini:Tinifile;
    messageList:TStrings;
    i:integer;
begin
try
if not FileExists(ExtractFilePath(paramstr(0))+'SetupInfo.ZTD') then
begin
myini:=Tinifile.Create(ExtractFilePath(paramstr(0))+'SetupInfo.ZTD');
myini.WriteString('授权','UserInfo','授权给：顶尖高手网吧城');
myini.WriteString('提示','NoteCaption','友情提示：请上机的同时保管好自己的物品，买东西时请准备好现金！');
myini.WriteFloat('饮料','可乐',1);
myini.WriteFloat('食品','方便面',3);
myini.WriteFloat('烟类','白沙烟',4.5);
myini.WriteString('消息','message1','麻烦过来一下，我这机子有点问题。');
myini.WriteString('消息','message2','我要买的东西上面没有，请过来一下。');
myini.WriteString('消息','message3','我有个游戏需要下载一下，请帮忙下载。');
myini.Free;
end;
setupform:=Tsetupform.Create(self);
myini:=Tinifile.Create(ExtractFilePath(paramstr(0))+'SetupInfo.ZTD');
MessageList:=TStringList.Create;
MessageList.Clear;
myini.ReadSection('消息',MessageList);
for i:=0 to MessageList.Count -1 do
begin
setupform.ListBox1.Items.Add(myini.ReadString('消息',MessageList[i],''));
end;
setupform.UserInfoEdit.Text:=myini.ReadString('授权','UserInfo','授权给：顶尖高手网吧城');
setupform.NoteEdit.Text:=myini.ReadString('提示','NoteCaption','友情提示：请上机的同时保管好自己的物品，买东西时请准备好现金！');
MessageList.Free;
myini.Free;
if not FileExists(ExtractFilePath(paramstr(0))+'system.ZTD') then
begin
myini:=Tinifile.Create(ExtractFilePath(paramstr(0))+'system.ZTD');
myini.WriteBool('SYSTEM','AutoRun',True);
myini.WriteBool('SYSTEM','AutoStartService',True);
myini.Free;
end;
myini:=Tinifile.Create(ExtractFilePath(paramstr(0))+'system.ZTD');
if myini.ReadBool('SYSTEM','AutoRun',False)=True then
setupform.CheckBox1.Checked:=True else setupform.CheckBox1.Checked:=False;
if myini.ReadBool('SYSTEM','AutoStartService',False)=True then
setupform.CheckBox2.Checked:=True else setupform.CheckBox2.Checked:=False;
myini.Free;
setupform.ShowModal;
finally
setupform.Free;
end;
end;

procedure TServerForm.FormCreate(Sender: TObject);
var myini:Tinifile;
    SaleList:TStrings;
    i:integer;
var UpdateForm:TUpdateForm;
begin
//检查版本信息
try
if NeedUpdate=True then
begin
try
UpdateForm:=TUpdateForm.Create(self);
UpdateForm.Timer1.Enabled:=True;
UpdateForm.ShowModal;
finally
UpdateForm.Free;
end;
end;
except
exit;
end;
if FileExists(ExtractFilePath(paramstr(0))+'log.txt') then DeleteFile(ExtractFilePath(paramstr(0))+'log.txt');
StatusBar1.Panels[1].Text:='※※※  北京时间：'+formatdatetime('hh:mm:ss',now)+'  ※※※';
messagecount:=0;
PageControl1.ActivePageIndex:=0;
if not FileExists(ExtractFilePath(paramstr(0))+'system.ZTD') then
begin
myini:=Tinifile.Create(ExtractFilePath(paramstr(0))+'system.ZTD');
myini.WriteBool('SYSTEM','AutoRun',True);
myini.WriteBool('SYSTEM','AutoStartService',True);
myini.Free;
ServerForm.Show;
end;

myini:=Tinifile.Create(ExtractFilePath(paramstr(0))+'system.ZTD');
if myini.ReadBool('SYSTEM','AutoStartService',true)=True then
begin
IdTCPServer1.DefaultPort := 5208;
IdTCPServer1.Active:=True;
MesTCPServer.DefaultPort := 5209;
MesTCPServer.Active:=True;
N1.Enabled:=False;
N2.Enabled:=True;
end;
myini.Free;

if not FileExists(ExtractFilePath(paramstr(0))+'SetupInfo.ZTD') then
begin
myini:=Tinifile.Create(ExtractFilePath(paramstr(0))+'SetupInfo.ZTD');
myini.WriteString('授权','UserInfo','授权给：顶尖高手网吧城');
myini.WriteString('提示','NoteCaption','友情提示：请上机的同时保管好自己的物品，买东西时请准备好现金！');
myini.WriteFloat('饮料','可乐',1);
myini.WriteFloat('食品','方便面',3);
myini.WriteFloat('烟类','白沙烟',4.5);
myini.WriteString('消息','message1','麻烦过来一下，我这机子有点问题。');
myini.WriteString('消息','message2','我要买的东西上面没有，请过来一下。');
myini.WriteString('消息','message3','我有个游戏需要下载一下，请帮忙下载。');
myini.Free;
end;
myini:=Tinifile.Create(ExtractFilePath(paramstr(0))+'SetupInfo.ZTD');
ServerForm.Caption:=' 网吧商品销售平台服务端 '+'（'+myini.ReadString('授权','UserInfo','授权给：顶尖高手网吧城')+'）';
SaleList:=TStringList.Create;
SaleList.Clear;
myini.ReadSections(SaleList);
for i:=0 to SaleList.Count -1 do
begin
if (trim(saleList[i])<>'授权') and (trim(saleList[i])<>'提示') and (trim(saleList[i])<>'消息') then
begin
Listview3.Items.Add.Caption:=salelist[i];
end;
end;
SaleList.Free;
myini.Free;
if FileExists(ExtractFilePath(paramstr(0))+'ZTD.TMP') then DeleteFile(ExtractFilePath(paramstr(0))+'ZTD.TMP');
if CopyFile(Pchar(ExtractFilePath(paramstr(0))+'SetupInfo.ZTD'),Pchar(ExtractFilePath(paramstr(0))+'ZTD.TMP'),False)=False then
begin
application.MessageBox('重建商品索引文件失败！','错误',MB_ICONERROR);
application.Terminate;
end;
SendFileStream:=TFileStream.Create(Pchar(ExtractFilePath(paramstr(0))+'ZTD.TMP'),fmOpenRead);
end;

procedure TServerForm.N2Click(Sender: TObject);
begin
N1.Checked:=False;
N2.Checked:=True;
N1.Enabled:=True;
N2.Enabled:=False;
MesTCPServer.Active:=False;
IdTCPServer1.Active:=False;
end;

procedure TServerForm.N1Click(Sender: TObject);