{ [zhangyin] 2011-08-12 新的多线路服务器投入使用,因同步数据太麻烦,暂采用简化办法。 新程序只连接新服务器,老服务器依然运行,供老版本程序使用。 每天自动或手动将老服务器的新增用户复制到新服务器。 如果老服务器的新增用户与新服务器已有用户重名,则按如下条件判断: 1、名称一样,密码不同,判断为不同的用户; 2、名称密码都一样,判断为同一用户。 加入矩阵随机替换加密方式 其形式如下:第一行为明文,第一列为密钥 先把密码一行一行地写成矩形块, 如明文密码为:ABCD,写成矩阵为: A B C D A A B C D B B C D A C C D A B D D A B C 密钥为随机数:a[i] := Random(Lenth(ABCD)) 比如生成的密钥为 2231 然后依据密钥按行读出(密钥指定了每行读值的位置)如上面第一次读取数据: 查找第一行的第2个位置并读出,每行的读取位置就是算法的密钥。 密钥2231下此密文为BCAD 其实就是构造一个不可逆的矩阵空间,这个空间上的运算是基本的矩阵变换。 数据库中密文保存形式为[密钥]:[密文](上面的为2231BCAD),用户每次登陆都会生成不同的密钥,故每次密文不一样 没有解密过程:(根据原始密码(明文)生成的矩阵不可逆)(每个密码生成一个特定的矩阵: 检查密码是要两方面的数据: 1. 用户原始密码生成的矩阵 2. 根据矩阵生成的密文与数据库中保存的密文对比); 这样在数据库中不直接存放明文(存放密钥跟加密后的密文)。 注:当用户密码丢失后,由于矩阵不可逆,不能再找回密码,只有根据这个账号重新申请用户账号(确定用户可以用账号 跟邮箱确定。重新申请密码后返回给用户) } unit ScClientDM; interface uses SysUtils, Classes, DB, ADODB, Windows, IniFiles, ScConsts, WinSock, StdCtrls; type EClientData = class(Exception); TClientData = class(TDataModule) acServer: TADOConnection; aqQuery: TADOQuery; aqQuery2: TADOQuery; acThread: TADOConnection; aqThread: TADOQuery; private { Private declarations } FUserID: Integer; FOnlineID: Integer; function ConnectServer: Boolean; // 为减轻服务器负担,一定要在完成操作后断开服务器; procedure CloseConnection; function GetConnectString: string; // 返回值:-2:用户取消登录;-1:无法连接服务器;0:成功;1:密码错误;2:用户名错误; // 3:授权码错误(首次登录);4:授权已过期;5:用户被禁用 // 6:用户登录次数超限;7:服务器在线人数超限; 8:尚未获得授权 // 9:申请被拒绝 function InnerLogin: Integer; function ConnectServerThread: Boolean; // 修改用户信息并重新申请账号 function ReRequest(AUserID: Integer): Boolean; public { Public declarations } function Login: Boolean; // 为减轻服务器负担,一定要在完成操作后断开服务器; procedure CloseConnectionThread; function CheckServer: Boolean; // 前提是用户已登录,所以不用再检查,直接改 function ChangePWD: Boolean; // 未登陆时修改密码 function ChangePWDBeforeLogin: Boolean; // 检查用户名是否存在 function UserExists(AUserName: string): Boolean; // 输入用户资料 function InputUserInfo(AUserID: Integer = -1): Boolean; // 登出 function Logout: Boolean; // 加密方法 function EncryptionBySecret(ASecretCode: string): string; // 通过密钥加密 function EncryptionByKey(KeyArr: array of Integer; APWD: String): string; function DecryptByKey(ASource: string; APWD: string): String; // 16位随机字符 function Get16Char(ALength: Integer): string; function AddSpaceToString(aSource: string): string; end; // 个人认为原始代码写得太啰嗦,对该类重新进行简化和封装 chenshilong, 2011-05-13 11:13:28 TScUserConfigInfo = class(TObject) private FIniFile: TIniFile; FUserName: string; FPassWord: string; FNewPassWord: string; FNewPassWord1: string; FNewPassWord2: string; FFirstLogon: Boolean; FRememberUser: Boolean; FVersion: Integer; public constructor Create; virtual; destructor Destroy; override; property UserName: string read FUserName write FUserName; property PassWord: string read FPassWord write FPassWord; property NewPassWord: string read FNewPassWord write FNewPassWord; property NewPassWord1: string read FNewPassWord1 write FNewPassWord1; property NewPassWord2: string read FNewPassWord2 write FNewPassWord2; property FirstLogon: Boolean read FFirstLogon write FFirstLogon; property RememberUser: Boolean read FRememberUser write FRememberUser; property Version: Integer read FVersion write FVersion; procedure LoadFromFile; procedure SaveToFile; // 是否记忆用户名和密码 procedure RememberUserInfo(ARemember: Boolean); function LockStr(AStr: String): WideString; function AHostToIP(AName: string; var Aip: string): Boolean; end; function ClientData: TClientData; var UserConfigInfo: TScUserConfigInfo; implementation uses Forms, Controls, S4CryptUtils, ScLoginFrm, DateUtils, ScUtils, ScProgressFrm, ScUserInfoFrm, ShellAPI, ScLicenseCodeFrm, Math, ScModifyPwdFrm; {$R *.dfm} const // server.smartcost arrPWD: array [0..19] of Byte = ($00, $00, $00, $10, $8C, $8B, $9C, $90, $8D, $8B, $92, $9E, $D1, $8C, $9A, $8D, $8D, $89, $8C, $9A); SctUser = 'User'; SctVersion = 'Version'; var g_ClientData: TClientData = nil; function ClientData: TClientData; begin if g_ClientData = nil then g_ClientData := TClientData.Create(nil); Result := g_ClientData; end; { TClientData } function TClientData.ChangePWD: Boolean; var strPWD: string; I: Integer; ReturnCopy: string; endWord: Char; begin Result := False; if SetupPassWord(strPWD) then begin for I := 1 to Length(strPWD) do begin ReturnCopy := Copy(strPWD, I, 1); endWord := ReturnCopy[1]; if Ord(endWord) >= 128 then begin MessageWarning(0, '请不要在密码中输入汉字。'); Result := False; Exit; end; end; ShowFloatProgress('正在与服务器通信,请稍候……', 100); Screen.Cursor := crHourGlass; try if ConnectServer then begin try aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Update ScUsers Set Pwd = ''%s'' Where ID = %d', [strPWD, FUserID])); aqQuery.SQL.Add(Format('Update ScUsers Set EPwd = '''' Where ID = %d', [FUserID])); aqQuery.SQL.Add(Format('Update ScUsers Set NEPwd = '''' Where ID = %d', [FUserID])); aqQuery.SQL.Add(Format('Update ScUsers Set NPwd = '''' Where ID = %d', [FUserID])); // 如果修改行数小于0,则说明服务器上没有本用户登录数据,检测失败 Result := aqQuery.ExecSQL > 0; aqQuery.Close; finally CloseConnection; end; end; finally Screen.Cursor := crDefault; CloseFloatProgress; end; end; end; // 连接服务器进行状态检查 // 是否检查用户名、密码???? function TClientData.ChangePWDBeforeLogin: Boolean; var strName, strPWD, strNewPWD1, strNewPWD2, QueryStr: string; IsUserExist: Boolean; Len, AUserID, i: Integer; ArrKey: array of Integer; begin if ShowModifyPwdForm(strName, strPWD, strNewPWD1, strNewPWD2) then begin if strNewPWD1 <> strNewPWD2 then begin Result := False; MessageWarning(0, '两次输入新密码不一致!请重新输入。'); Exit; end; try CreateProgressForm(100, '连接服务器,请稍候>>>'); if ConnectServer then begin AddProgressForm(30, '服务器已连接,正在修改密码...'); try aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select *, GetDate() As Now From ScUsers Where Name=''%s''', [strName])); aqQuery.Open; // 检查用户名是否正确 if aqQuery.RecordCount = 0 then begin Result := False; MessageWarning(0, '服务器上无此用户,请确认用户名是否输入正确。'); Exit; end; AddProgressForm(30, '服务器已连接,正在检查用户...'); // 可能有重名用户(原因见本单元顶部) IsUserExist := False; if aqQuery.RecordCount > 1 then begin aqQuery.First; while not aqQuery.Eof do begin // 判断密码 QueryStr := aqQuery.FieldByName('EPWD').AsString; // 二代密码中无三代中的密钥跟密文区别符空格.所以要先加上 if (Pos(' ', QueryStr) = 0) and (QueryStr <> '') then begin QueryStr := AddSpaceToString(QueryStr); end; // 这里是最老的版本第一次使用新版本时,为登陆直接修改密码的情况 if (CompareStr(strPWD, aqQuery.FieldByName('Pwd').AsString) = 0) and (aqQuery.FieldByName('Pwd').AsString <> '') then begin // 当名称与密码相同时,判断为同一用户 IsUserExist := True; AUserID := aqQuery.FieldByName('ID').AsInteger; Break; end // 二代密码第一次登陆新版本修改密码的情况 else if (DecryptByKey(QueryStr, strPWD) = QueryStr) and (aqQuery.FieldByName('EPWD').AsString <> '')then begin // 当名称与密码相同时,判断为同一用户 IsUserExist := True; AUserID := aqQuery.FieldByName('ID').AsInteger; Break; end; aqQuery.Next; end; end else if aqQuery.RecordCount = 1 then begin // 判断密码 QueryStr := aqQuery.FieldByName('EPWD').AsString; // 二代密码中无三代中的密钥跟密文区别符空格.所以要先加上 if (Pos(' ', QueryStr) = 0) and (QueryStr <> '') then begin QueryStr := AddSpaceToString(QueryStr); end; // 这里是最老的版本第一次使用新版本时,为登陆直接修改密码的情况 if (CompareStr(strPWD, aqQuery.FieldByName('Pwd').AsString) = 0) and (aqQuery.FieldByName('Pwd').AsString <> '') then begin // 当名称与密码相同时,判断为同一用户 IsUserExist := True; AUserID := aqQuery.FieldByName('ID').AsInteger; end // 二代密码第一次登陆新版本修改密码的情况 else if (DecryptByKey(QueryStr, strPWD) = QueryStr) and (aqQuery.FieldByName('EPWD').AsString <> '')then begin // 当名称与密码相同时,判断为同一用户 IsUserExist := True; AUserID := aqQuery.FieldByName('ID').AsInteger; end; end; AddProgressForm(30, '服务器已连接,正在检查原密码...'); if not IsUserExist then begin Result := False; MessageWarning(0, '原密码错误,请确认。'); Exit; end else begin // 所有的修改密码过后都将其当做最老版本来处理,即Pwd有数据 // 其余三个字段无数据 AddProgressForm(10, '服务器已连接,正在修改成新密码...'); aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Update ScUsers Set Pwd = ''%s'' Where ID = %d', [strNewPWD1, AUserID])); aqQuery.SQL.Add(Format('Update ScUsers Set EPwd = '''' Where ID = %d', [AUserID])); aqQuery.SQL.Add(Format('Update ScUsers Set NEPwd = '''' Where ID = %d', [AUserID])); aqQuery.SQL.Add(Format('Update ScUsers Set NPwd = '''' Where ID = %d', [AUserID])); aqQuery.ExecSQL; end; UserConfigInfo.FUserName := strName; UserConfigInfo.FPassWord := strNewPWD1; finally CloseConnection; end; end else begin Result := False; MessageWarning(0, '无法连接服务器,请检查网络设置。'); end; finally CloseFloatProgress; end; end; end; function TClientData.CheckServer: Boolean; begin Result := False; if ConnectServerThread then begin try aqThread.SQL.Clear; aqThread.SQL.Add(Format('Update ScOnlineUsers Set UpdateTime = GetDate() Where ID = %d', [FOnlineID])); // 如果修改行数小于0,则说明服务器上没有本用户登录数据,检测失败 Result := aqThread.ExecSQL > 0; aqThread.Close; finally CloseConnectionThread; end; end; end; procedure TClientData.CloseConnection; begin if acServer.Connected = True then acServer.Close; end; procedure TClientData.CloseConnectionThread; begin if acThread.Connected = True then acThread.Close; end; function TClientData.ConnectServer: Boolean; begin if acServer.Connected then begin Result := True; Exit; end; acServer.ConnectionString := GetConnectString; try acServer.Open; except end; // 联机失败,则重试一次 if not acServer.Connected then begin try acServer.Open; except end; end; Result := acServer.Connected; end; function TClientData.ConnectServerThread: Boolean; begin acThread.ConnectionString := GetConnectString; try acThread.Open; except end; // 联机失败,则重试一次 if not acThread.Connected then begin try acThread.Open; except end; end; Result := acThread.Connected; end; function TClientData.EncryptionByKey(KeyArr: array of Integer; APWD: string): string; var CiphertextArr: array of string; StrArr: array of string; Ciphertext: string; LenStr, i, j: Integer; begin Ciphertext := ''; LenStr := Length(APWD); SetLength(CiphertextArr, LenStr); SetLength(StrArr, LenStr); // 解析明文:StrArr for i := 0 to LenStr - 1 do begin StrArr[i] := Copy(APWD, i + 1, 1); end; // 构造密文表:CiphertextArr for i := 0 to LenStr - 1 do begin for j := 0 to LenStr - 1 do begin if j + i >= LenStr then begin CiphertextArr[i] := CiphertextArr[i] + StrArr[i + j - LenStr]; end else CiphertextArr[i] := CiphertextArr[i] + StrArr[i + j]; end; end; // 加密 // 初始化密文头: 密钥 for i := 0 to LenStr - 1 do begin Ciphertext := Ciphertext + IntToStr(KeyArr[i]) + ' '; end; // 加上密文尾: 根据密钥查找密文表得出. for i := 0 to LenStr - 1 do begin Ciphertext := Ciphertext + Copy(CiphertextArr[i], KeyArr[i], 1); end; Result := Ciphertext; end; function TClientData.EncryptionBySecret(ASecretCode: string): string; var KeyArr: array of Integer; LenStr, i, j: Integer; begin LenStr := Length(ASecretCode); SetLength(KeyArr, LenStr); // 随机构造密钥:KeyArr for i := 0 to LenStr - 1 do begin Randomize; KeyArr[i] := Random(LenStr); if KeyArr[i] = 0 then begin KeyArr[i] := 1; end; end; // 加密 Result := EncryptionByKey(KeyArr, ASecretCode); end; function TClientData.Get16Char(ALength: Integer): string; const CodeBuf: array[0..35] of Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z'); var Temp: string; Num: Integer; begin Temp := ''; while Length(Temp) < ALength do begin Randomize; Num := Random(36); Temp := Temp + CodeBuf[Num]; end; Result := Temp; end; function TClientData.GetConnectString: string; var strPWD: string; arrResult: array of Byte; iOutputLength: Integer; slstServer: TStringList; I: Integer; strIP: string; begin iOutputLength := GetOutputLength(arrPWD); SetLength(arrResult, iOutputLength); Decrypt_Simple(arrPWD, Length(arrPWD), arrResult, iOutputLength); SetString(strPWD, PChar(@arrResult[0]), iOutputLength); slstServer := TStringList.Create; slstServer.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Data\ServerList'); for I := 0 to slstServer.Count - 1 do begin if UserConfigInfo.AHostToIP(slstServer[I], strIP) then slstServer[I] := strIP; end; Result := 'Provider=SQLOLEDB.1;Persist Security Info=True;' + 'Data Source=' + slstServer[0] +';User ID=sa;Password=' + strPWD + ';Network Library=dbmssocn'; // + 'Data Source=192.168.1.3;User ID=sa;Password=' + strPWD; slstServer.Free; end; function TClientData.InnerLogin: Integer; var strName, strPWD, strVer, strLicenseCode, tmpPWD, Key, Char16, ReturnCopy, QueryStr: string; ArrKey: array of Integer; dtNow, dtLicense: TDateTime; bNew, bFirstLogon, NoSpaceFlag, bLogin, bNoUser, IsAllChinese: Boolean; gGUID: TGUID; iLoginLimit, iOnlineLimit, iOnlineUsers, iServerID, Len, i, ChineseCount: Integer; endWord: Char; begin Result := -2; bLogin := False; // 登录 if ShowLoginForm(strName, strPWD) then begin CreateProgressForm(100, '连接服务器,请稍候>>>'); AddProgressForm(10, '正在连接服务器,该过程可能需要较长时间...'); RefreshProgressTime(1000); // 3分钟 try if ConnectServer then begin try AddProgressForm(20, '服务器已连接,正在检查在线情况...'); // 先查询ScOnlineLimit和ScOnlineUsers表,判断登录人数是否超过限制 aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add('Select * From ScOnlineLimit'); aqQuery.Open; aqQuery.First; iOnlineLimit := aqQuery.FieldByName('OnlineLimit').AsInteger; aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add('Select Count(*) As OnlineCount From ScOnlineUsers'); aqQuery.Open; aqQuery.First; iOnlineUsers := aqQuery.FieldByName('OnlineCount').AsInteger; aqQuery.Close; if iOnlineUsers > iOnlineLimit then begin Result := 7; Exit; end; AddProgressForm(10, '服务器已连接,正在验证用户名和密码...'); aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select *, GetDate() As Now From ScUsers Where Name=''%s''', [strName])); aqQuery.Open; // 检查用户名是否正确 if aqQuery.RecordCount = 0 then begin Result := 2; Exit; end; // [zhangyin] 2011-08-12 // 可能有重名用户(原因见本单元顶部) if aqQuery.RecordCount > 1 then begin bNoUser := True; aqQuery.First; while not aqQuery.Eof do begin // 判断密码 QueryStr := aqQuery.FieldByName('EPWD').AsString; // 二代密码中无三代中的密钥跟密文区别符空格.所以要先加上 if (Pos(' ', QueryStr) = 0) and (QueryStr <> '')then begin QueryStr := AddSpaceToString(QueryStr); end; // 这里是最老的版本第一次使用新版本时的情况 if (CompareStr(strPWD, aqQuery.FieldByName('Pwd').AsString) = 0) and (aqQuery.FieldByName('Pwd').AsString <> '') then begin bNoUser := False; Break; end // 二代密码第一次登陆新版本的情况 else if (DecryptByKey(QueryStr, strPWD) = QueryStr) and (aqQuery.FieldByName('EPWD').AsString <> '')then begin bNoUser := False; Break; end; aqQuery.Next; end; // 返回密码错误 if bNoUser then begin Result := 1; Exit; end; end; AddProgressForm(10, '服务器已连接,正在检查登录权限...'); // 检查该用户是否重复登陆 FUserID := aqQuery.FieldByName('ID').AsInteger; iLoginLimit := aqQuery.FieldByName('LoginLimit').AsInteger; // 登录限制>0,则表示限制该ID登录次数 if iLoginLimit > 0 then begin aqQuery2.Close; aqQuery2.SQL.Clear; aqQuery2.SQL.Add(Format('Select * From ScOnlineUsers Where UserID = %d', [FUserID])); aqQuery2.Open; // 发现重复在线信息 if aqQuery2.RecordCount > 0 then begin // 检查本机重复在线情况 aqQuery2.First; while not aqQuery2.Eof do begin gGUID := StringToGUID(aqQuery2.FieldByName('LocalGUID').AsString); // 本机存在重复,因Exe本身会检查重复运行情况,所以不再进行判断 if IsLocalGUID(gGuid) then begin bLogin := True; FOnlineID := aqQuery2.FieldByName('ID').AsInteger; Break; end; aqQuery2.Next; end; // 登录次数超限 if (not bLogin) and (iLoginLimit <= aqQuery2.RecordCount) then begin Result := 6; aqQuery2.Close; Exit; end; end; aqQuery2.Close; end // 登录限制0,则表示不限制该ID登录次数 else begin gGUID := GetLocalGUID; aqQuery2.Close; aqQuery2.SQL.Clear; aqQuery2.SQL.Add(Format('Select * From ScOnlineUsers Where LocalGUID = ''%s''', [GUIDToString(gGUID)])); aqQuery2.Open; // 发现重复在线信息 if aqQuery2.RecordCount > 0 then begin bLogin := True; FOnlineID := aqQuery2.FieldByName('ID').AsInteger; end; aqQuery2.Close; end; // 检查用户是否被禁用 if not aqQuery.FieldByName('Enabled').AsBoolean then begin Result := 5; Exit; end; // 检查用户申请是否被拒绝 if aqQuery.FieldByName('Denied').AsBoolean then begin Result := 9; Exit; end; // 检查密码 AddProgressForm(10, '服务器已连接,正在检查密码...'); if aqQuery.FieldByName('EPwd').AsString <> '' then begin // 判断密码 QueryStr := aqQuery.FieldByName('EPwd').AsString; // 二代密码中无三代中的密钥跟密文区别符空格.所以要先加上 if Pos(' ', QueryStr) = 0 then begin QueryStr := AddSpaceToString(QueryStr); NoSpaceFlag := True; end; if DecryptByKey(QueryStr, strPWD) <> QueryStr then begin Result := 1; Exit; end; // 重新加密 // 修改过后的密文存入NEPwd // 每次登陆,随机修改密码 // 修改过后的密文在次出入数据库 // 判断是否全是汉字 IsAllChinese := True; ChineseCount := 0; for i := 1 to Length(strPWD) do begin ReturnCopy := Copy(strPWD, i, 1); endWord := ReturnCopy[1]; if Ord(endWord) < 128 then begin IsAllChinese := False; end else ChineseCount := ChineseCount + 1; end; // 对汉字个数占密码长度大于1/3,这样会出现很长时间的循环,现有的办法无法处理,这种情况 // 返回总部重置密码,这种情况只在这次之前注册的用户会出现,这次之后注册的用户中 // 密码没有汉字 2012.3.29 if (ChineseCount > (Length(strPWD) div 3)) and (not IsAllChinese)then begin Result := 10; Exit; end; tmpPWD := EncryptionBySecret(strPWD); ReturnCopy := Copy(tmpPWD, Length(tmpPWD), 1); endWord := ReturnCopy[1]; // 在不是全是汉字的情况下,处理中文拆字符出现',导致下面SQL语句出错(排除全是汉字的情况) if not IsAllChinese then begin while (Ord(endWord) >= 128) do begin tmpPWD := EncryptionBySecret(strPWD); ReturnCopy := Copy(tmpPWD, Length(tmpPWD), 1); endWord := ReturnCopy[1]; end; end; aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Update ScUsers Set EPwd = ''%s'' where ID = %d',[tmpPWD, FUserID])); aqQuery.ExecSQL; // 处理处理Pwd aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select * from ScUsers where ID = %d',[FUserID])); aqQuery.Open; if aqQuery.FieldByName('Pwd').AsString <> '' then begin aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Update ScUsers Set Pwd = '''' where ID = %d',[FUserID])); aqQuery.ExecSQL; end; end else begin if CompareStr(strPWD, aqQuery.FieldByName('Pwd').AsString) <> 0 then begin Result := 1; Exit; end; // 每次登陆,随机修改密码 // 修改过后的密文在次出入数据库 IsAllChinese := True; ChineseCount := 0; for i := 1 to Length(strPWD) do begin ReturnCopy := Copy(strPWD, i, 1); endWord := ReturnCopy[1]; if Ord(endWord) < 128 then begin IsAllChinese := False; end else ChineseCount := ChineseCount + 1; end; // 对汉字个数占密码长度大于1/3,这样会出现很长时间的循环,现有的办法无法处理,这种情况 // 返回总部重置密码,这种情况只在这次之前注册的用户会出现,这次之后注册的用户中 // 密码没有汉字 2012.3.29 if (ChineseCount > (Length(strPWD) div 3)) and (not IsAllChinese)then begin Result := 10; Exit; end; tmpPWD := EncryptionBySecret(strPWD); ReturnCopy := Copy(tmpPWD, Length(tmpPWD), 1); endWord := ReturnCopy[1]; // 在不是全是汉字的情况下,处理中文拆字符出现',导致下面SQL语句出错(排除全是汉字的情况) if not IsAllChinese then begin while (Ord(endWord) >= 128) do begin tmpPWD := EncryptionBySecret(strPWD); ReturnCopy := Copy(tmpPWD, Length(tmpPWD), 1); endWord := ReturnCopy[1]; end; end; aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Update ScUsers Set EPwd = ''%s'' where ID = %d',[tmpPWD, FUserID])); aqQuery.SQL.Add(Format('Update ScUsers Set Pwd = '''' where ID = %d',[FUserID])); aqQuery.ExecSQL; end; // 检查授权日期 aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select *, GetDate() As Now From ScUsers Where ID = %d', [FUserID])); aqQuery.Open; if not aqQuery.FieldByName('LicenseDate').IsNull then begin dtLicense := DateOf(aqQuery.FieldByName('LicenseDate').AsDateTime); dtNow := DateOf(aqQuery.FieldByName('Now').AsDateTime); if dtNow > dtLicense then begin Result := 4; Exit; end; end; // 首次登陆,则检查授权码 { bNew := aqQuery.FieldByName('New').AsBoolean; if bNew then begin if aqQuery.FieldByName('LicenseCode').AsString = '' then begin Result := 8; Exit; end; strLicenseCode := ScInputBox('输入授权码', '您是首次登录,请输入授权码(不分大小写)', ''); if strLicenseCode = '' then if MessageQuest('如果您尚未获得授权码,请进入纵横产品论坛获取您的授权码。' + #13#10'点“确定”将转入纵横论坛。') then begin ShellExecute(0, nil, 'http://bbs.smartcost.com.cn', nil, nil, SW_SHOWNORMAL); Exit; end; if not SameText(strLicenseCode, aqQuery.FieldByName('LicenseCode').AsString) then begin Result := 3; Exit; end; end; } aqQuery.Close; // 首次登录成功,修改New字段状态 if bNew then begin aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Update ScUsers Set New = 0 Where Name = ''%s''', [strName])); aqQuery.ExecSQL; aqQuery.Close; end; AddProgressForm(10, '登录验证成功,正在记录登录信息...'); // 至此登录验证成功,下面需要记录登录信息,修改在线状态表。 strVer := 'VerBE'; if bLogin then begin aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Update ScOnlineUsers Set LoginTime = GetDate(), ' + 'UpdateTime = GetDate(), %s = 1, Mac = ''%s'' Where ID = %d', [strVer, MacAddress, FOnlineID])); aqQuery.ExecSQL; aqQuery.Close; end else begin gGUID := GetLocalGUID; aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Insert Into ScOnlineUsers (UserID, LoginTime, UpdateTime, LocalGUID, %s, Mac) ' + 'Values (%d, GetDate(), GetDate(), ''%s'', 1, ''%s'') ', [strVer, FUserID, GUIDToString(gGUID), MacAddress])); aqQuery.ExecSQL; aqQuery.Close; // 新增在线状态需要根据本机GUID获得在线ID备用 aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select ID From ScOnlineUsers Where LocalGUID=''%s''', [GUIDToString(gGUID)])); aqQuery.Open; FOnlineID := aqQuery.FieldByName('ID').AsInteger; aqQuery.Close; // 记录登录log aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Insert Into ScUserLog (UserID, LoginTime, Mac) ' + 'Values (%d, GetDate(), ''%s'') ', [FUserID, MacAddress])); aqQuery.ExecSQL; aqQuery.Close; end; Result := 0; // 登录成功 UserConfigInfo.FUserName := strName; UserConfigInfo.FPassWord := strPWD; UserConfigInfo.RememberUserInfo(UserConfigInfo.RememberUser); finally CloseConnection; end; end else Result := -1; finally CloseFloatProgress; end; end; end; // 字符串格式是:项名称|值|字段名|是否必填(0/1) function TClientData.InputUserInfo(AUserID: Integer): Boolean; var strName, strPWD, strCode, strDate: string; slstMain, slstSub: TStringList; gNewGUID: TGUID; strFields, strValues: string; iID, I, J, iExeKind: Integer; begin Result := False; slstMain := TStringList.Create; slstSub := TStringList.Create; slstSub.Delimiter := '|'; strFields := ''; strValues := ''; try if ConnectServer then begin try aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select * From ScUsers Where ID = %d', [AUserID])); aqQuery.Open; strName := aqQuery.FieldByName('Name').AsString; strPWD := aqQuery.FieldByName('PWD').AsString; aqQuery.Close; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select * From ScUserInfo Where ID = %d', [AUserID])); aqQuery.Open; // 是新申请用户 if (AUserID = -1) or (aqQuery.RecordCount = 0) then begin slstMain.Add('真实姓名||Name|1'); slstMain.Add('单位名称||Company|1'); slstMain.Add('联系地址||Address|1'); slstMain.Add('所在省份||Province|1'); slstMain.Add('电话号码||PhoneNum|1'); slstMain.Add('手机号码||MobileNum|0'); slstMain.Add('传真号码||FaxNum|0'); slstMain.Add('QQ号码||QQ|1'); // slstMain.Add('MSN||MSN|0'); slstMain.Add('电子邮件||EMail|1'); end else begin aqQuery.First; slstMain.Add(Format('真实姓名|%s|Name|1', [aqQuery.FieldByName('Name').AsString])); slstMain.Add(Format('单位名称|%s|Company|1', [aqQuery.FieldByName('Company').AsString])); slstMain.Add(Format('联系地址|%s|Address|1', [aqQuery.FieldByName('Address').AsString])); slstMain.Add(Format('所在省份|%s|Province|1', [aqQuery.FieldByName('Province').AsString])); slstMain.Add(Format('QQ号码|%s|QQ|1', [aqQuery.FieldByName('QQ').AsString])); slstMain.Add(Format('电话号码|%s|PhoneNum|1', [aqQuery.FieldByName('PhoneNum').AsString])); slstMain.Add(Format('手机号码|%s|MobileNum|0', [aqQuery.FieldByName('MobileNum').AsString])); slstMain.Add(Format('传真号码|%s|FaxNum|0', [aqQuery.FieldByName('FaxNum').AsString])); // slstMain.Add(Format('MSN|%s|MSN|0', [aqQuery.FieldByName('MSN').AsString])); slstMain.Add(Format('电子邮件|%s|EMail|1', [aqQuery.FieldByName('EMail').AsString])); end; aqQuery.Close; if ShowUserInfoForm(strName, strPWD, slstMain, AUserID = -1) then begin ShowFloatProgress('正在提交数据,请稍候……', 100); Screen.Cursor := crHourGlass; try // 是新申请用户 if AUserID = -1 then begin CreateGUID(gNewGUID); // lengshumei 2009-12-3 Randomize; // strCode := IntToHex(RandomRange($132, $FFE), 3) + IntToHex(RandomRange($21, $EF), 2) // + IntToHex(RandomRange($01A, $FEF), 3); // 授权期限到 365天*5年 后 strDate := DateToStr(now + 1825); iExeKind := 4; // 清单编制 // 向ScUsers表插入记录 aqQuery.SQL.Clear; // aqQuery.SQL.Add(Format('Insert Into ScUsers (Name, Pwd, New, Enabled, CanChangePWD, LicenseCode, LicenseDate, LoginLimit, NewGUID, ExeKind) ' // + 'Values (''%s'', ''%s'', %d, %d, %d, ''%s'', ''%s'', %d, ''%s'', %d)', // [strName, strPwd, 1, 1, 1, strCode, strDate, 1, GUIDToString(gNewGUID), iExeKind])); aqQuery.SQL.Add(Format('Insert Into ScUsers (Name, Pwd, New, Enabled, CanChangePWD, LicenseDate, LoginLimit, NewGUID, ExeKind) ' + 'Values (''%s'', ''%s'', %d, %d, %d, ''%s'', %d, ''%s'', %d)', [strName, strPwd, 1, 1, 1, strDate, 1, GUIDToString(gNewGUID), iExeKind])); aqQuery.ExecSQL; // 根据GUID获得用户ID aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select ID From ScUsers Where NewGUID = ''%s''', [GUIDToString(gNewGUID)])); aqQuery.Open; if aqQuery.RecordCount = 0 then raise EClientData.Create('提交数据失败,请检查网络设置'); // 获得用户ID aqQuery.First; iID := aqQuery.FieldByName('ID').AsInteger; end else iID := AUserID; // 检查是否原来就存在用户资料 aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select * From ScUserInfo Where ID = %d', [iID])); aqQuery.Open; if aqQuery.RecordCount = 0 then begin aqQuery.Close; // 向ScUserInfo表插入用户资料 for I := 0 to slstMain.Count - 1 do begin slstSub.Clear; slstSub.DelimitedText := slstMain[I]; if strFields <> '' then strFields := strFields + ', '; strFields := strFields + slstSub[2]; if strValues <> '' then strValues := strValues + ' ,'; strValues := strValues + '''' + slstSub[1] + ''''; end; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Insert Into ScUserInfo (ID, %s, RegDate) Values (%d, %s, GetDate())', [strFields, iID, strValues])); Result := aqQuery.ExecSQL > 0; end else begin aqQuery.Close; // 修改ScUserInfo表原有用户资料 for I := 0 to slstMain.Count - 1 do begin slstSub.Clear; slstSub.DelimitedText := slstMain[I]; if strValues <> '' then strValues := strValues + ', '; strValues := strValues + slstSub[2] + '=''' + slstSub[1] + ''''; end; aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Update ScUserInfo Set %s, RegDate = GetDate() Where ID = %d', [strValues, iID])); Result := aqQuery.ExecSQL > 0; end; finally CloseFloatProgress; Screen.Cursor := crDefault; end; end; finally CloseConnection; end; end; finally slstMain.Free; slstSub.Free; end; // if Result then // ShowLicenseCode(strCode); end; function TClientData.Login: Boolean; begin Result := False; // 返回值:-2:用户取消登录;-1:无法连接服务器;0:成功;1:密码错误;2:用户名错误; // 3:授权码错误(首次登录);4:授权已过期;5:用户被禁用 // 6:用户登录次数超限;7:服务器在线人数超限; 8:尚未获得授权 // 9:申请被拒绝 case InnerLogin of -2: {no hint}; -1: MessageWarning(0, '无法连接服务器,请检查网络设置。'); 0: Result := True; 1: MessageWarning(0, '密码错误!请重试。'); //ShowLoginForm(Fusername, fpassword); 2: MessageWarning(0, '用户名错误。'); // 3: MessageWarning(0, '授权码错误。'); 4: MessageWarning(0, '授权已过期。'); 5: MessageWarning(0, Format('用户未被启用。如有问题,请联系纵横客服。', [LoadServiceQQ])); 6: MessageWarning(0, '您已在别的地方登录,故本次登陆失败。'#13#10 + '有疑问请电:0756-3850888。'); 7: MessageHint(0, '服务器在线人数超限,请稍后重试。'); // 8: MessageHint(0, Format('您尚未获得授权。如有问题,请联系纵横客服。', [LoadServiceQQ])); 9: if MessageWarning(0, '您的申请未审核通过,因为您填写的资料信息不足。'#13#10 + '需要修改您的资料,并重新提交申请吗?', '提示', MB_YESNO) = IDYES then ReRequest(FUserID); 10: MessageWarning(0, Format('您的密码中不合规范。请联系纵横客服重置密码,客服电话。', [LoadServiceQQ])); end; end; function TClientData.Logout: Boolean; var bCanDelete: Boolean; bVer1, bVer2, bVer3: Boolean; strVer: string; begin Result := False; if ConnectServer then begin try // 先查询是否有其它版本的Exe在运行, 如有,则只修改版本标记,如无,则删除在线记录 aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select * From ScOnlineUsers Where ID = %d', [FOnlineID])); aqQuery.Open; bVer1 := aqQuery.FieldByName('Ver1').AsBoolean; bVer2 := aqQuery.FieldByName('Ver2').AsBoolean; bVer3 := aqQuery.FieldByName('Ver3').AsBoolean; aqQuery.Close; {$IFDEF _ScBills} bCanDelete := not (bVer2 or bVer3); strVer := 'Ver1'; {$ENDIF} {$IFDEF _ScBudget} {$IFDEF _ScEstimate} bCanDelete := not (bVer1 or bVer2); strVer := 'Ver3'; {$ELSE} bCanDelete := not (bVer1 or bVer3); strVer := 'Ver2'; {$ENDIF} {$ENDIF} {$IFDEF _beOnLine} bCanDelete := not (bVer1 or bVer2 or bVer3); strVer := 'VerBE'; {$ENDIF} if bCanDelete then begin // 删除在线数据 aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Delete From ScOnlineUsers Where ID = %d', [FOnlineID])); // 如果修改行数小于0,则说明服务器上没有本用户登录数据,检测失败 Result := aqQuery.ExecSQL > 0; aqQuery.Close; // 记录登录log aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Insert Into ScUserLog (UserID, LogoutTime, Mac) ' + 'Values (%d, GetDate(), ''%s'') ', [FUserID, MacAddress])); aqQuery.ExecSQL; aqQuery.Close; end else begin // 修改版本信息 aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Update ScOnlineUsers Set %s = 0 Where ID = %d', [strVer, FOnlineID])); // 如果修改行数小于0,则说明服务器上没有本用户登录数据,检测失败 Result := aqQuery.ExecSQL > 0; aqQuery.Close; end; finally CloseConnection; end; end; end; function TClientData.ReRequest(AUserID: Integer): Boolean; begin Result := InputUserInfo(AUserID); if Result then MessageHint(0, '您的申请已经成功提交,请联系QQ:549244533获取授权码。'); end; function TClientData.DecryptByKey(ASource: string; APWD: string): String; var Longth, flag, flag1, i: Integer; TmpSouce: string; beforStr: string; AfterStr: string; intArr: array of Integer; begin Result := ''; if (Length(ASource) < 20) and (Pos(' ', ASource) = 0) then begin Longth := Length(APWD); SetLength(intArr, Longth); for i := 1 to Longth do begin intArr[i - 1] := StrToInt(Copy(ASource, i, 1)); end; end else begin TmpSouce := ASource; Longth := 0; while Pos(' ', TmpSouce) > 0 do begin flag := Pos(' ', TmpSouce); Longth := Longth + 1; beforStr := Copy(TmpSouce, 1, flag - 1); AfterStr := Copy(TmpSouce, flag + 1, Length(TmpSouce) - flag); TmpSouce := ''; TmpSouce := beforStr + AfterStr; end; SetLength(intArr, Longth); Longth := 0; flag1 := 1; while Pos(' ', ASource) > 0 do begin flag := Pos(' ', ASource); Longth := Longth + 1; beforStr := Copy(ASource, 1, flag - 1); intArr[Longth -1] := StrToInt(Copy(beforStr, flag1 , Length(beforStr) -flag1 +1)); AfterStr := Copy(ASource, flag + 1, Length(ASource) - flag); ASource := ''; ASource := beforStr + AfterStr; flag1 := flag; end; end; Result := EncryptionByKey(intArr, APWD); end; function TClientData.UserExists(AUserName: string): Boolean; begin Result := True; ShowFloatProgress('正在与服务器通信,请稍候……', 100); Screen.Cursor :=crHourGlass; try if ConnectServer then begin try aqQuery.SQL.Clear; aqQuery.SQL.Add(Format('Select * From ScUsers Where Name = ''%s''', [AUserName])); // 如果修改行数小于0,则说明服务器上没有本用户登录数据,检测失败 aqQuery.Open; Result := aqQuery.RecordCount > 0; aqQuery.Close; finally CloseConnection; end; end else raise EClientData.Create('连接服务器失败'); finally Screen.Cursor := crDefault; CloseFloatProgress; end; end; { TUserConfigInfo } constructor TScUserConfigInfo.Create; begin FIniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'OnlineUser.ini'); LoadFromFile; end; destructor TScUserConfigInfo.Destroy; begin FIniFile.Free; inherited; end; procedure TScUserConfigInfo.LoadFromFile; var OutPutPassWordLength: Integer; sPassWord: string; bInPutPassWord, bOutPutPassWord: array of Byte; begin Fversion := FIniFile.ReadInteger(SctVersion, 'Version', 0); FUserName := FIniFile.ReadString(SctUser, 'UserName', ''); sPassWord := FIniFile.ReadString(SctUser, 'PassWord', ''); if FVersion = 0 then FPassWord := sPassWord else FPassWord := LockStr(sPassWord); // FFirstLogon := FIniFile.ReadBool(SctUser, 'FirstLogon', True); FRememberUser := FIniFile.ReadBool(SctUser, 'RememberUser', True); end; procedure TScUserConfigInfo.RememberUserInfo(ARemember: Boolean); var bInPutPassWord, bOutPutPassWord: array of Byte; OutPutPassWordLength, i: Integer; sPassWord: string; begin FRememberUser := ARemember; FIniFile.WriteBool(SctUser, 'RememberUser', ARemember); if ARemember then begin FIniFile.WriteString(SctUser, 'UserName', FUserName); sPassWord := LockStr(FPassWord); FIniFile.WriteString(SctUser, 'PassWord', sPassWord); end else begin FIniFile.WriteString(SctUser, 'UserName', ''); FIniFile.WriteString(SctUser, 'PassWord', ''); end; FIniFile.WriteInteger(SctVersion, 'Version', 90401); end; procedure TScUserConfigInfo.SaveToFile; var bInPutPassWord, bOutPutPassWord: array of Byte; OutPutPassWordLength: Integer; sPassWord: string; begin FIniFile.WriteString(SctUser, 'UserName', FUserName); sPassWord := LockStr(FPassWord); FIniFile.WriteString(SctUser, 'PassWord', sPassWord); // FIniFile.WriteBool(SctUser, 'FirstLogon', FFirstLogon); FIniFile.WriteBool(SctUser, 'RememberUser', FRememberUser); FIniFile.WriteInteger(SctVersion, 'Version', 90401); end; function TScUserConfigInfo.LockStr(AStr: String): WideString; var I: Integer; STemp, sCompare: String; const sStr: String = 'UXtnGjc4dIBkosvCPQSrDYFZJhTewliyLMaH70uW95xbVzOKq3E1Rmpf8AN62g'; begin Result := ''; for I := 1 to Length(AStr) do begin sCompare := ''; sCompare := sCompare + AStr[I]; if Pos(sCompare, sStr)>0 then Stemp := Stemp + sStr[63 - Pos(sCompare, sStr)] else Stemp := Stemp + AStr[I]; end; Result := STemp; end; function TScUserConfigInfo.AHostToIP(AName: string; var Aip: string): Boolean; var Wsdata: TWSAData; HostName: array[0..255] of Char; HostEnt: PHostEnt; Addrs: PChar; begin WSAStartup($0101,Wsdata); try gethostname(HostName, SizeOf(HostName)); StrPCopy(HostName, AName); HostEnt := gethostbyname(HostName); if Assigned(HostEnt) then begin if Assigned(HostEnt^.h_addr_list) then begin Addrs := HostEnt^.h_addr_list^; if Assigned(Addrs) then begin Aip := Format('%d.%d.%d.%d', [byte(Addrs[0]), byte(Addrs[1]), byte(Addrs[2]), byte(Addrs[3])]); Result := True; end else Result := False; end else Result := False; end else Result := False finally WSACleanup; end; end; function TClientData.AddSpaceToString(aSource: string): string; var i, Len: Integer; begin i := 2; Len := Length(aSource); while i <= Len do begin Insert(' ', aSource, i); i := i + 2; end; Result := aSource; end; initialization UserConfigInfo := TScUserConfigInfo.Create; finalization if g_ClientData <> nil then g_ClientData.Free; UserConfigInfo.Free; end.