|
p align="left">end; ErrImputWorkNumberFault: SMessage ('Imput work number fault'); ErrImputTeacherNumberFault: SMessage ('Imput work number fault'); ErrQuestionsNotFound: SMessage ('No questions found in base'); ErrConfigIniFileWorkSetNotFound: SMessage ('Config file WorkSet.ini not found'); ErrReadBuiletNumber: SMessage ('Error with read number of builet'); ErrQuestionWithInputedNumberNotFound: SMessage ('Direstory with inputed number (QuestionNum) is not found (number out of range)'); ErrQuestionFileWithInputedNumberNotFound: SMessage ('File with inputed number (QuestionName) is not found (number out of range)'); ErrInSelectedDirectoryNotQuestFileNameFound: SMessage ('In the selected tirectory question file is not found'); ErrGenerationRndQuest: SMessage ('Error by generation random question file maybe question directory is not found'); ErrInvalidFileNameTraslate: SMessage ('Invalid Translate question name filename STR to INT maybe filename error'); end; end; Procedure TQuestDB.SMessage (Message_:string); begin SendMessage (SelfParent, WM_User+2, DWord (PChar(TransactionUser+' '+Message_)), 0); end; /////////////////QUESTIONS //////////////// function TQuestDB. UpdateQuestionsSet:boolean; var QCount:integer; EnumFileDir:TSearchRec; FOptions:TIniFile; TryConvert:TDateTime; WorkTimeLim:string; begin QuestionsPathName:=ProgRootDir+'\Questions\'+ActiveWork+'\'+ActiveTeacher; try try FOptions:=TIniFile. Create (QuestionsPathName+'\WorkSet.ini'); QuestCount:=FOptions. ReadInteger ('QuestionCount', 'value', - 1); WorkTimeLim:=FOptions. ReadString ('TimeForWork', 'value', '0:00:00'); TryConvert:=StrToTime(WorkTimeLim); WorkTimeLimit_:=WorkTimeLim; ImgType:=FOptions. ReadString ('ImgType', 'value', 'bmp'); FOptions. Destroy; finally if QuestCount>0 then result:=true else result:=false; end; except result:=false; end; end; function TQuestDB. ConverHLrToIntNum (StringNum:string):integer; var ProtectAssign:integer; begin if TestByDigit(StringNum) then begin ProtectAssign:=StrToInt(StringNum); result:=ProtectAssign; end else begin ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrReadBuiletNumber); result:=-1; end; end; function TQuestDB. TestByDigit (DataString:string):boolean; var DataLen:byte; Offs:byte; begin Result:=true; DataLen:=Length(DataString); for Offs:=1 to DataLen do if not (DataString[Offs] in ['0'..'9']) then begin result:=false; break; end; end; function TQuestDB. GetBuiletByNum (Num:integer):string; var EnumBuiletsFile:TSearchRec; StringBuiletNum:string; begin Result:=''; FindFirst (QuestionsPathName+'\*', faDirectory, EnumBuiletsFile); repeat if EnumBuiletsFile. Name[1]<>'.' then begin StringBuiletNum:=EnumBuiletsFile. Name; if TestByDigit(StringBuiletNum) then if ConverHLrToIntNum(StringBuiletNum)=Num then begin result:=QuestionsPathName+'\'+EnumBuiletsFile. Name; break; end; end; until FindNext(EnumBuiletsFile)<>0; FindClose(EnumBuiletsFile); If Result='' then ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrQuestionWithInputedNumberNotFound); end; function TQuestDB. GetFileBuiletByNumBuilet (BuiletNum, FileNum:integer):string; var EnumBuiletsNamesFile:TSearchRec; StringBuiletNum:string; begin Result:=''; FindFirst (QuestionsPathName+'\'+IntToStr(BuiletNum)+'\*', faAnyFile, EnumBuiletsNamesFile); repeat if EnumBuiletsNamesFile. Name[1]<>'.' then begin StringBuiletNum:=EnumBuiletsNamesFile. Name; Delete (StringBuiletNum, Length(StringBuiletNum) - 3,4); if TestByDigit(StringBuiletNum) then if ConverHLrToIntNum(StringBuiletNum)=FileNum then begin result:=QuestionsPathName+'\'+EnumBuiletsNamesFile. Name; break; end; end; until FindNext(EnumBuiletsNamesFile)<>0; FindClose(EnumBuiletsNamesFile); If Result='' then ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrQuestionFileWithInputedNumberNotFound); end; function TQuestDB. GetRandomFileBuilet (BuiletNum:integer):string; var EnumBuiletsNamesFile:TSearchRec; RndCount:integer; FileList:HLringList; WorkPath:string; begin Result:=''; FileList:=HLringList. Create; FileList. Clear; WorkPath:=QuestionsPathName+'\'+IntToStr(BuiletNum); if DirectoryExists(WorkPath) then begin FindFirst (WorkPath+'\*', faAnyFile, EnumBuiletsNamesFile); repeat if EnumBuiletsNamesFile. Name[1]<>'.' then FileList. Add (EnumBuiletsNamesFile. Name); until FindNext(EnumBuiletsNamesFile)<>0; FindClose(EnumBuiletsNamesFile); if FileList. Count>0 then begin Randomize; RndCount:=Random (FileList. Count); Result:=QuestionsPathName+'\'+IntToStr(BuiletNum)+'\'+FileList. Strings[RndCount]; end; end; FileList. Destroy; If Result='' then ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrGenerationRndQuest); end; function TQuestDB. GetTrueAnswerForBuilet (QuestionPath:string):integer; var QuestNum:integer; TmpStr:string; KeyFilePath:string; TempQuestionsList:HLringList; begin Result:=-1; QuestNum:=0; TmpStr:=ExtractFileName(QuestionPath); Delete (TmpStr, Length(TmpStr) - Length (ExtractFileExt(TmpStr))+1, Length (ExtractFileExt(TmpStr))); if (TestByDigit(TmpStr)) and (Length(TmpStr)<5) then begin QuestNum:=StrToInt(TmpStr); end else begin ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrInvalidFileNameTraslate); Result:=-1; exit; end; KeyFilePath:=ExtractFilePath (ExtractFileDir(QuestionPath))+'QuestKey.ini'; if FileExists(KeyFilePath) then begin TempQuestionsList:=HLringList. Create; TempQuestionsList. LoadFromFile(KeyFilePath); Result:=StrToInt (TempQuestionsList. Strings[QuestNum]); TempQuestionsList. Destroy; end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrConfigIniFileWorkSetNotFound); end; function TQuestDB. SetTrueAnswerForBuilet (QuestionPath:string; TrueAnswer: Integer):boolean; var QuestNum:integer; TmpStr:string; KeyFilePath:string; TempQuestionsList:HLringList; begin Result:=false; QuestNum:=0; TmpStr:=ExtractFileName(QuestionPath); Delete (TmpStr, Length(TmpStr) - Length (ExtractFileExt(TmpStr))+1, Length (ExtractFileExt(TmpStr))); if (TestByDigit(TmpStr)) and (Length(TmpStr)<5) then begin QuestNum:=StrToInt(TmpStr); end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrInvalidFileNameTraslate); KeyFilePath:=ExtractFilePath (ExtractFileDir(QuestionPath))+'QuestKey.ini'; if FileExists(KeyFilePath) then begin TempQuestionsList:=HLringList. Create; TempQuestionsList. LoadFromFile(KeyFilePath); TempQuestionsList. Strings[QuestNum]:=IntToStr(TrueAnswer); TempQuestionsList. SaveToFile (KeyFilePath+'_'); TempQuestionsList. Destroy; DeleteFile(KeyFilePath); RenameFile (KeyFilePath+'_', KeyFilePath); Result:=true; end else ERROR_MESSAGE_FOR_DEBUG_LEVEL(ErrConfigIniFileWorkSetNotFound); end; end. unit UBaseWork; interface uses Windows, Messages, SysUtils, Classes, Dialogs, IniFiles; const ErrImputGroupNumberFault = 1; ErrImputUserNumberFault = 2; type UsersDBase=record Groups:HLringList; Users:array of HLringList; end; type TUsersDB = class private SelfParent:HWND; UsersDataBase: UsersDBase; GroupsCount:integer; ProgRootDir:string; ActiveGroup:string; ActiveUser:string; ActivStationIP:string; ActiveGroupNum:byte; ActiveUserNum:byte; procedure ERROR_MESSAGE_FOR_DEBUG_LEVEL (ErrID: byte); procedure SMessage (Message_: string); public property TransactionIP:string read ActivStationIP write ActivStationIP; property ActiveUserName:string read ActiveUser; property ActiveGroupName:string read ActiveGroup; function SetActiveGroup (Num: byte): boolean; function SetActiveUser (Num: byte): boolean; function GetGroupByIndex (i: byte): string; function GetUserByIndex (i: byte): string; function GetGroupsStringList: string; function GetUsersStringList: string; constructor Create (ParentHwnd:HWND); destructor Destroy; override; end; implementation {TQuestDB} constructor TUsersDB. Create (ParentHwnd: HWND); var ExeName:PChar; AppName: String; ExeNameLen:byte; ///// NewSearch_:TSearchRec; CleanName:string; i:byte; begin SelfParent:=ParentHwnd; GetMem (ExeName, 255); ExeNameLen:=255; GetModuleFileName (0, ExeName, ExeNameLen); // определяем имя исполняемого модуля AppName:=StrPas(ExeName); ProgRootDir:=ExtractFileDir(AppName); GroupsCount:=0; UsersDataBase. Groups:=HLringList. Create; FindFirst (ProgRootDir+'\Groups\*', faDirectory, NewSearch_); repeat if NewSearch_.Name[1]<>'.' then begin UsersDataBase. Groups. Add (NewSearch_.Name); inc(GroupsCount); end; until FindNext (NewSearch_)<>0; FindClose (NewSearch_); SetLength (UsersDataBase. Users, GroupsCount); for i:=0 to GroupsCount-1 do begin UsersDataBase. Users[i]:=HLringList. Create; UsersDataBase. Users[i].LoadFromFile (ProgRootDir+'\Groups\'+UsersDataBase. Groups. Strings[i]); CleanName:=UsersDataBase. Groups. Strings[i]; Delete (CleanName, Length(CleanName) - 3,4); UsersDataBase. Groups. Strings[i]:=CleanName; end; end; destructor TUsersDB. Destroy;
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11
| 
