代码拉取完成,页面将自动刷新
unit formMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SkinCaption, WinSkinData, ExtCtrls, StdCtrls, WiIniCom, FileCtrl, TLHelp32, ShellAPI,
ComCtrls, ScktComp, Sockets, EncdDecd, uMD5, LbRSA, LbAsym,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, superobject,
Menus;
const
CFG_DIR = 'config';
CFG_FILE = 'config.cfg';
CFG_NAME_PRE = '#fileName:';
type
TTextFormat=(tfAnsi,tfUnicode,tfUnicodeBigEndian,tfUtf8);
const
TextFormatFlag:array[tfAnsi..tfUtf8] of word=($0000,$FFFE,$FEFF,$EFBB);
type
TfrmMain = class(TForm)
SkinData1: TSkinData;
SkinCaption1: TSkinCaption;
pnlToolbar: TPanel;
pnlBottom: TPanel;
spBottom: TSplitter;
btnClose: TButton;
mmoLog: TMemo;
WiIniCom: TWiIniCom;
pgMain: TPageControl;
tabNginx: TTabSheet;
tabInterface: TTabSheet;
pnlMain: TPanel;
lbedNginxPath: TLabeledEdit;
btnSelectNginx: TButton;
btnSelectCode: TButton;
lbedHtmlPath: TLabeledEdit;
mmoFileList: TMemo;
pnlLeft: TPanel;
splLeft: TSplitter;
grpLeft: TGroupBox;
lbConfig: TListBox;
pnl1: TPanel;
btnConfig: TButton;
btnCopyFile: TButton;
btnGetToken: TButton;
lbedUserName: TLabeledEdit;
lbedPassword: TLabeledEdit;
cbEnvironment: TComboBox;
lblEnvironment: TLabel;
cliSockMain: TClientSocket;
tcpClientMain: TTcpClient;
svrSockMain: TServerSocket;
lbedEncryPassword: TLabeledEdit;
lblVersion: TLabel;
btnClear: TButton;
btnMD5: TButton;
idhttpMain: TIdHTTP;
btnCheckUpdate: TButton;
pmRefresh: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
procedure btnCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure lbConfigDblClick(Sender: TObject);
procedure btnSelectNginxClick(Sender: TObject);
procedure btnSelectCodeClick(Sender: TObject);
procedure btnConfigClick(Sender: TObject);
procedure btnCopyFileClick(Sender: TObject);
procedure svrSockMainClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure svrSockMainClientWrite(Sender: TObject;
Socket: TCustomWinSocket);
procedure btnClearClick(Sender: TObject);
procedure btnCheckUpdateClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N3Click(Sender: TObject);
private
{ Private declarations }
// 加载配置文件
function LoadConfig: string;
// 保存配置文件
procedure SaveConfig;
// 获取配置文件列表
procedure GetCfgList(strConfName: string);
// 选择配置
procedure SelectCfg;
// 读取命令行
function GetDosOutput(CommandLine: string; strDir: string): string;
// 连接服务器
procedure connectServer;
// 获取文件内容
function getFileText(fileName: string): string;
// 下载升级文件
procedure DownLoadUpdateFile;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
g_strPath: string;
implementation
{$R *.dfm}
// 根据开始和结束符取得中间字符串
function CenterStr(const strSrc : String; const strBegin : String; const strEnd : String) : String;
var
iPosBegin, iPosEnd: integer;
strSrcLow, strBeginLow, strEndLow: String;
begin
strSrcLow := LowerCase(strSrc);
strBeginLow := LowerCase(strBegin);
strEndLow := LowerCase(strEnd);
iPosBegin := Pos(strBeginLow, strSrcLow) + Length(strBeginLow);
iPosEnd := Pos(strEndLow, strSrcLow);
result := Copy(strSrc, iPosBegin, iPosEnd - iPosBegin);
end;
// 获取配置值
function GetConfigValue(const strSrc : string; strConfigName: string): string;
begin
result := CenterStr(strSrc, '<' + strConfigName + '>', '</' + strConfigName + '>');
end;
{新建一个TXT文档}
Procedure NewTxt(FileName:String);
Var
F : Textfile; {定义 F 为 Textfile}
Begin
AssignFile(F,FileName); {将文件名与变量 F 关联}
ReWrite(F); {创建Txt文档并命名为 “FileName ” }
Closefile(F); {关闭文件 F}
End;
{先附上原内容在写入新内容}
Procedure AppendTxt(Str:String;FileName:String);
Var
F:Textfile;
Begin
AssignFile(F, FileName);
Append(F); {附上原来的内容以免原内容被清空}
Writeln(F, Str); {把内容 Ser 写入文件F }
Closefile(F);
End;
// 记录日志
procedure WriteTxtLog(const strFileName, strContent: string);
var
strDir: string;
begin
try
if (Trim(strFileName) = '') then
exit;
strDir := ExtractFileDir(strFileName);
// 如果文件夹不存在,则创建
if (not DirectoryExists(strDir)) then
begin
ForceDirectories(strDir);
Application.ProcessMessages;
Sleep(100);
Application.ProcessMessages;
end;
// 如果文件不存在,则创建
if (not FileExists(strFileName)) then
begin
NewTxt(strFileName);
Application.ProcessMessages;
Sleep(100);
Application.ProcessMessages;
end;
AppendTxt(strContent, strFileName);
except
;
end;
end;
// 打印日志
procedure WriteLog(const strText : string; const isNoDate: Boolean = false);
var
dt: TDateTime;
strLogText, strLogFileName: string;
begin
dt := Now();
if not isNoDate then
begin
strLogText := FormatDateTime('yyyy-mm-dd hh:mm:ss', dt) + ' ';
end;
strLogText := strLogText + strText;
frmMain.mmoLog.Lines.Add(strLogText);
strLogFileName := FormatDateTime('yyyymmdd', dt);
strLogFileName := g_strPath + 'log\' + strLogFileName + '.txt';
WriteTxtLog(strLogFileName, strLogText);
end;
//取得文件版本
function GetFileVer(strFileName: String): String;
var
n, Len: DWORD;
Buf : PChar;
Value: Pointer;
szName: array [0..255] of Char;
Transstring: String;
begin
Len := GetFileVersionInfoSize(PChar(strFileName), n);
if Len > 0 then
begin
Buf := AllocMem(Len);
if GetFileVersionInfo(Pchar(strFileName), n, Len, Buf) then
begin
Value := nil;
VerQueryValue(Buf, '\VarFileInfo\Translation', Value, Len);
if Value <> nil then
begin
Transstring := IntToHex(MakeLong(HiWord(LongInt(Value^)), LoWord(LongInt(Value^))),8);
end;
StrPCopy(szName, '\stringFileInfo\' + Transstring + '\FileVersion');
if VerQueryValue(Buf, szName, Value, Len) then
begin
Result := StrPas(Pchar(Value));
end;
FreeMem(Buf, n);
end;
end;
end;
procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
Close;
end;
// 加载配置文件
function TfrmMain.LoadConfig: string;
var
strConfName: string;
strlist: TStringList;
begin
wiIniCom.Section := 'main';
lbedNginxPath.Text := wiIniCom.ReadSection('NGINX_PATH');
lbedHtmlPath.Text := wiIniCom.ReadSection('HTML_PATH');
if not FileExists(lbedNginxPath.Text + '\nginx.exe') then
begin
WriteLog('找不到nginx文件:' + lbedNginxPath.Text + '\nginx.exe,请确认配置是否正确!');
end
else if FileExists(lbedNginxPath.Text + '\conf\nginx.conf') then
begin
strlist := TStringList.Create;
strlist.Text := Trim(getFileText(lbedNginxPath.Text + '\conf\nginx.conf'));
if strlist.Count > 0 then
begin
strConfName := strlist.Strings[0];
if Pos(CFG_NAME_PRE, strConfName) = 0 then
begin
strConfName := '';
end;
end;
end;
result := strConfName;
end;
// 保存配置文件
procedure TfrmMain.SaveConfig;
begin
wiIniCom.Section := 'main';
wiIniCom.WriteSection('NGINX_PATH', lbedNginxPath.Text);
wiIniCom.WriteSection('HTML_PATH', lbedHtmlPath.Text);
end;
// 获取配置文件列表
procedure TfrmMain.GetCfgList(strConfName: string);
var
sr: TSearchRec;
fr: Integer;
begin
lbConfig.Items.Clear;
fr := FindFirst(g_strPath + CFG_DIR + '\*.conf', faAnyFile, sr);
while fr = 0 do
begin
if (sr.Attr = faDirectory) and (sr.Name <> '.') and (sr.Name <> '..') then
begin
continue;
end;
lbConfig.Items.Add(sr.Name);
if (CFG_NAME_PRE + sr.Name = strConfName) then
begin
lbConfig.Selected[lbConfig.Items.Count - 1] := true;
end;
fr := FindNext(sr);
end;
FindClose(sr);
end;
//Utf8ToAnsi
// 获取文件内容
function TfrmMain.getFileText(fileName: string): string;
var
s: string;
tt: TMemoryStream;
i: Integer;
Filebuf: array of pchar;
begin
if not FileExists(fileName) then
begin
Result := '';
Exit;
end;
i := 0;
tt := TMemoryStream.Create;
tt.LoadFromFile(fileName);
i := tt.Size;
SetLength(Filebuf, i);
tt.ReadBuffer(Filebuf[0], i);
s := StrPas(@Filebuf[0]);
//s := Utf8ToAnsi(s);
result := s;
end;
// 程序创建
procedure TfrmMain.FormCreate(Sender: TObject);
var
strConfName, strVersion: string;
begin
g_strPath := ExtractFilePath(Application.ExeName);
WiIniCom.IniFile := g_strPath + CFG_DIR + '\' + CFG_FILE;
strConfName := LoadConfig;
GetCfgList(strConfName);
strVersion := GetFileVer(Application.ExeName);
frmMain.Caption := frmMain.Caption + ' ' + strVersion;
lblVersion.Caption := lblVersion.Caption + ' ' + strVersion;
pgMain.ActivePage := tabNginx;
cbEnvironment.Items.Text := getFileText(g_strPath + 'config\server_list.cfg');
if (cbEnvironment.Items.Count > 0) then
begin
cbEnvironment.ItemIndex := 0;
end;
end;
// 选择配置
procedure TfrmMain.SelectCfg;
var
i, iPos: integer;
strConf, strNginxConf, strCmd, strCmdRet, strConfName: string;
strlist: TStringList;
begin
strConf := '';
for i := 0 to lbConfig.Items.Count - 1 do
begin
if (lbConfig.Selected[i] = true) then
begin
strConf := lbConfig.Items[i];
break;
end;
end;
if (strConf = '') then
begin
MessageBox(Handle, PChar('请选择配置!'), '提示', 64);
Exit;
end;
if ID_YES <> MessageBox(Handle, PChar('确认要使用配置[' + strConf + ']?'), '提示', MB_YESNO or MB_ICONQUESTION) then
begin
exit;
end;
WriteLog('正在应用配置:' + strConf + '.....');
strNginxConf := lbedNginxPath.Text + '\conf\nginx.conf';
WriteLog('正在修改配置:' + strNginxConf + '.....');
strlist := TStringList.Create;
strlist.Text := getFileText(g_strPath + CFG_DIR + '\' + strConf);
for i := 0 to strlist.Count - 1 do
begin
if (Pos('root', strlist.Strings[i]) > 0) and ((Pos(lbedHtmlPath.Text, strlist.Strings[i]) > 0)) then
begin
strlist.Strings[i] := #9 + 'root "' + lbedHtmlPath.Text + '";';
end;
end;
strConfName := strlist.Strings[0];
iPos := Pos(CFG_NAME_PRE, strConfName);
if iPos = 0 then
begin
strlist.Insert(0, CFG_NAME_PRE + strConf);
end
else
begin
strlist.Strings[0] := CFG_NAME_PRE + strConf;
end;
strlist.SaveToFile(strNginxConf);
Sleep(200);
strCmd := lbedNginxPath.Text + '\nginx.exe -s reload';
WriteLog(strCmd);
strCmdRet := GetDosOutput(strCmd, lbedNginxPath.Text);
WriteLog(strCmdRet);
if Pos('cannot find the file', strCmdRet) > 0 then
begin
WriteLog('正在启动nginx.....');
ShellExecute(Handle, '', PChar(lbedNginxPath.Text + '\nginx.exe'), '', PChar(lbedNginxPath.Text), SW_HIDE);
end;
WriteLog(strCmdRet);
WriteLog('修改完成');
end;
procedure TfrmMain.lbConfigDblClick(Sender: TObject);
begin
SelectCfg;
end;
procedure TfrmMain.btnSelectNginxClick(Sender: TObject);
var
dir: string;
begin
if SelectDirectory('选择目录 ', ' ', dir) then
begin
lbedNginxPath.Text := dir;
if not FileExists(lbedNginxPath.Text + '\nginx.exe') then
begin
MessageBox(Handle, PChar('找不到nginx文件:' + lbedNginxPath.Text + '\nginx.exe,请确认配置是否正确!'), '提示', 64);
Exit;
end;
SaveConfig;
end;
end;
procedure TfrmMain.btnSelectCodeClick(Sender: TObject);
var
dir: string;
begin
if SelectDirectory('选择目录 ', ' ', dir) then
begin
lbedHtmlPath.Text := dir;
SaveConfig;
end;
end;
// 配置
procedure TfrmMain.btnConfigClick(Sender: TObject);
begin
SelectCfg;
end;
// 读取命令行
function TfrmMain.GetDosOutput(CommandLine: string; strDir: string): string;
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array [0 .. 255] of AnsiChar;
BytesRead: Cardinal;
Handle: Boolean;
begin
Result := '';
with SA do
begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
Handle := CreateProcess(nil, PChar('cmd /c ' + CommandLine), nil, nil,
True, 0, nil, PChar(strDir), SI, PI);
CloseHandle(StdOutPipeWrite);
if Handle then
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
Result := Result + Buffer;
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
procedure TfrmMain.btnCopyFileClick(Sender: TObject);
var
i: integer;
strFileName, strNewFileName, strFileDir: string;
begin
for i := 0 to mmoFileList.Lines.Count - 1 do
begin
strFileName := mmoFileList.Lines.Strings[i];
strFileDir := ExtractFileDir(strNewFileName);
if not DirectoryExists(strFileDir) then
begin
try
begin
ForceDirectories(strFileDir);
end;
finally
end;
end;
WriteLog('复制文件到:' + strNewFileName);
CopyFile(PChar(strFileName), PChar(strNewFileName), false);
end;
end;
procedure TfrmMain.svrSockMainClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
WriteLog('client ' + Socket.RemoteAddress + ' connect');
end;
procedure TfrmMain.svrSockMainClientWrite(Sender: TObject;
Socket: TCustomWinSocket);
begin
WriteLog('client ' + Socket.RemoteAddress + ' write');
WriteLog(Socket.ReceiveText);
end;
// 连接服务器
procedure TfrmMain.connectServer;
var
strHost, strPort: string;
iPort: Integer;
begin
if cliSockMain.Active = true then
cliSockMain.Active := false;
strHost := Trim(cbEnvironment.Text);
strHost := Copy(strHost, Pos('(', strHost) + 1, Length(strHost));
strHost := Copy(strHost, 1, Pos(')', strHost) - 1);
iPort := 80;
if Pos(':', strHost) > 0 then
begin
strPort := Copy(strHost, Pos(':', strHost) + 1, Length(strHost));
strHost := Copy(strHost, 1, Pos(':', strHost) - 1);
TryStrToInt(strPort, iPort);
end;
cliSockMain.Active := false;
cliSockMain.Host := strHost;
cliSockMain.Port := iPort;
cliSockMain.Active := True;
end;
procedure TfrmMain.btnClearClick(Sender: TObject);
begin
mmoLog.Lines.Clear;
end;
// 版本号比较{返回版本差 版本号格式:1.0.0.1}
function CompareVersion(VersionA, VersionB: string): string;
var
listA: TStringList;
listB: TStringList;
i: Integer;
strCompare: string;
begin
Result := '';
// 创建
listA := TStringList.Create();
listB := TStringList.Create();
// 获取列表
ExtractStrings(['.'], [' '], PChar(VersionA), listA);
ExtractStrings(['.'], [' '], PChar(VersionB), listB);
if listA.Count <> listB.Count then
Exit;
// 比较
for i := 0 to listA.Count - 2 do
begin
strCompare := strCompare + IntToStr(StrToInt(listA[i]) - StrToInt(listB[i])) + '.';
end;
i := listA.Count - 1;
if i < 0 then
Exit;
strCompare := strCompare + IntToStr(StrToInt(listA[i]) - StrToInt(listB[i]));
// 释放
if Assigned(listA) then
FreeAndNil(listA);
if Assigned(listB) then
FreeAndNil(listB);
Result := strCompare;
end;
// 版本号转换为整数(和计算方式)
function VersionSumToInt(Version: string): Integer;
var
list: TStringList;
i: Integer;
nSum: Integer;
begin
Result := -1;
nSum := 0;
list := TStringList.Create();
ExtractStrings(['.'], [' '], PChar(Version), list);
for i := 0 to list.Count - 1 do
begin
if StrToIntDef(list[i], -1) < 0 then
Exit;
nSum := nSum + StrToInt(list[i]);
end;
if Assigned(list) then
FreeAndNil(list);
Result := nSum;
end;
// 下载升级文件
procedure TfrmMain.DownLoadUpdateFile;
var
strUpdateServer, strOldVersion, strNewVersion, strUpdateFile: string;
streamFile : TMemoryStream;
iniFile: TWiIniCom;
begin
try
iniFile := TWiIniCom.Create(nil);
iniFile.IniFile := g_strPath + 'update.ini';
strUpdateServer := iniFile.ReadFile('main', 'UPDATE_SERVER');
strOldVersion := GetFileVer(g_strPath + 'update.exe');
strNewVersion := idhttpMain.Get(strUpdateServer + 'update_file_version.txt');
if VersionSumToInt(CompareVersion(strNewVersion, strOldVersion)) > 0 then
begin
strUpdateFile := g_strPath + 'update.exe';
streamFile := TMemoryStream.Create;
idHttpMain.Get(strUpdateServer + 'update.exe', streamFile);
DeleteFile(strUpdateFile);
streamFile.SaveToFile(strUpdateFile);
WriteLog('升级程序版本' + strOldVersion + '升级为' + strNewVersion);
Sleep(200);
end;
except
end;
end;
procedure TfrmMain.btnCheckUpdateClick(Sender: TObject);
begin
DownLoadUpdateFile;
ShellExecute(Handle, 'open', PChar(g_strPath + 'Update.exe'), PChar(g_strPath), nil, 1);
end;
procedure TfrmMain.N1Click(Sender: TObject);
begin
GetCfgList('');
end;
procedure TfrmMain.N3Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', PChar(g_strPath + 'config'), PChar(g_strPath + 'config'), nil, 1);
end;
end.
此处可能存在不合适展示的内容,页面不予展示。您可通过相关编辑功能自查并修改。
如您确认内容无涉及 不当用语 / 纯广告导流 / 暴力 / 低俗色情 / 侵权 / 盗版 / 虚假 / 无价值内容或违法国家有关法律法规的内容,可点击提交进行申诉,我们将尽快为您处理。