📄 mainsrc.pas
字号:
@ActiveFunc := GetProcAddress(Lib,'SetActive');
@SetSkinFile:= GetProcAddress(Lib,'SetSkinFile');
@Add3rdControl:= GetProcAddress(Lib,'Add3rdControl');
end;
End;
procedure FreeDLL;
begin
if lib<>0 then freeLibrary(lib);
lib:=0;
InitProc := nil;
UnLoadProc:= nil;
end;
function EnCode(BeEncode:string):string;
var index,temp:integer;
begin
temp:=ord(BeEncode[1]);
temp:=temp xor 89;
inc(temp,13);
if temp<100 then
ReSult:='0'+inttostr(temp)
else
ReSult:=inttostr(temp);
for index:=2 to Length(BeEncode) do
begin
temp:=ord(BeEncode[index]);
temp:=temp xor 89;
Inc(temp,13);
if temp<100 then
ReSult:=concat(ReSult,'0',inttostr(temp))
else
ReSult:=concat(ReSult,inttostr(temp));
end;
end;
function DeCode(BeDecode:string):string;
var index:integer;
begin
ReSult:='';
for index:=0 to (length(BeDecode) div 3)-1 do
ReSult:=concat(ReSult,chr((strtoint(midstr(BeDecode,index*3+1,3))-13) xor 89));
ReSult:=Trim(ReSult);
end;
function GetTableAlias(tablealias:string):String;
var strlen,strpos,strdel:integer;
begin
strlen:=Length(TableAlias);
strpos:=Pos('_',TableAlias);
strdel:=strlen-strpos+1;
if Pos('_',TableAlias)>0 then
Delete(TableAlias,strpos,strdel);
result:=tableAlias;
end;
procedure TMain.FormDestroy(Sender: TObject);
begin
FreeDLL;
end;
procedure TMain.FormCreate(Sender: TObject);
begin
if lib=0 then loaddll;
if @InitProc <> nil Then InitProc(Handle);
if not FActive then
Begin
if @SetSkinFile <> nil Then SetSkinFile('skin2');
FActive := True;
end;
Current_User.UserName:='';
end;
procedure TMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if @UnLoadProc <> nil Then UnLoadProc;
end;
procedure TMain.Splitter1Moved(Sender: TObject);
begin
panel1.Constraints.MaxWidth:=clientwidth-PageCon.Width-4;
panel1.Constraints.MinWidth:=50;
Panel1.Width:=splitter1.Left;
PageCon.width:=clientwidth-splitter1.Left-splitter1.Width-4;
PageCon.Left:=splitter1.Left+splitter1.Width+2;
end;
procedure TMain.FormResize(Sender: TObject);
begin
PageCon.Width:=clientwidth-splitter1.Left-splitter1.Width-4;
PageCon.Left:=splitter1.Left+splitter1.Width+2;
GenPap.Left:=(PageCon.Width-GenPap.Width-2) div 2;
CreateDataBase.Left:=(PageCon.Width-CreateDataBase.Width-2) div 2;
end;
procedure TMain.FormShow(Sender: TObject);
begin
PageCon.Width:=clientwidth-splitter1.Left-splitter1.Width-4;
PageCon.Left:=splitter1.Left+splitter1.Width+2;
GenPap.Left:=(PageCon.Width-GenPap.Width) div 2;
CreateDataBase.Left:=(PageCon.Width-CreateDataBase.Width) div 2;
if TreeView1.Items.Item[0].Count>0 then
TreeView1.Items.Item[0].getFirstChild.expand(True);
panel2.Left:=(main.Width-panel2.Width) div 2;
panel2.Top:=(main.Height-panel2.Height) div 3 ;
login_user_name.SetFocus;
end;
procedure TMain.FormActivate(Sender: TObject);
begin
PapDat.DateTime:=now;
end;
procedure TMain.BitBtn8Click(Sender: TObject);
var PapStrIni,PapInfo:TIniFile;
TabList:TStringList;
TabCount,yearnow,monthnow,daynow,index:integer;
PapStrListItem:TListItem;
DB,dbnow,ext:String;
vJE:OLEVariant;
begin
totalscore.Caption:='0';
db:=Trim(PapInf_DBName.Text);
dbnow:='database\'+db;
ext:='database\'+MidStr(db,1,Length(db)-3)+'ldb';
TabList:=TStringList.Create;
if FileExists(Ext) then
begin
messagedlg(#13'数据库正在使用中，无法进行产生试卷前压缩操作！',mterror,[mbok],0);
abort;
end;
BitBtn8.Enabled:=False;
for index:=0 to 19 do
if Current_User.Created_DB[index]=db then break;
try
vJE:=CreateOleObject('JRO.JetEngine');
vJE.CompactDatabase(format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'+
'Jet OLEDB:Database Password=%s;',[dbnow,DeCode(Current_User.Authen_DB_Pass[index])]),
format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
+'Jet OLEDB:Database Password=%s;',[Ext,DeCode(Current_User.Authen_DB_Pass[index])]));
CopyFile(PChar(Ext),PChar(dbnow),false);
deletefile(Ext);
except
messagedlg(#13'数据库压缩失败，无法生成试卷！',mterror,[mbok],0);
BitBtn8.Enabled:=true;
abort;
end;
if ListView1.Items.Count>0 then
begin
repeat
ListView1.Items.Item[0].Delete;
until ListView1.Items.Count=0
end;
yearnow:=YearOf(date);monthnow:=MonthOf(date);daynow:=DayOf(date);
monthnow:=monthnow-StrtoInt(MidStr(Trim(LimMon.Text),1,2)) mod 12;
yearnow:=yearnow-StrtoInt(MidStr(Trim(LimMon.Text),1,2)) div 12;
if monthnow<0 then
begin
yearnow:=yearnow-1;
monthnow:=-monthnow;
end;
deadline:=yearnow*10000+monthnow*100+daynow;
for index:=0 to 19 do
if Current_User.Created_DB[index]=DB then break;
if FileExists('database\'+Trim(PapInf_dbname.Text)) then
begin
ADOConGenPap.Close;
try
ADOConGenPap.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source=database\'+DB+';Mode=Share Deny None;Persist Security Info=False;'+
'Jet OLEDB:Database Password='+DeCode(Current_User.Authen_DB_Pass[index]);
ADOConGenPap.Open;
except
messagedlg(#13'已找到数据库，连接失败！',mterror,[mbok],0);
ADOConGenPap.Close;
BitBtn8.Enabled:=true;
Abort;
end;
PapStrIni:=TIniFile.Create('.\database.ini');
PapInfo:=TIniFile.Create('.\ini\'+Trim(PapInf_DBName.Text)+'.ini');
ADOConGenPap.GetTableNames(TabList,false);
if TabList.Count>0 then
begin
ADOQueryGenPap.Connection:=ADOConGenPap;
for TabCount:=0 to TabList.Count-1 do
begin
PapStrListItem:=Listview1.Items.Add();
PapStrListItem.Caption:=InttoStr(TabCount);
PapStrListItem.SubItems.Insert(0,GetTableAlias(PapStrIni.ReadString(Trim(PapInf_dbname.Text),TabList.Strings[TabCount],'')));
if strtoint(MidStr(Trim(limmon.Text),1,2))<=PapInfo.ReadInteger('deadline','months',0) then
PapStrListItem.SubItems.Insert(1,PapInfo.ReadString(TabList.Strings[TabCount],'number','0'))
else PapStrListItem.SubItems.Insert(1,'0');
try
if length(ADOQueryGenPap.SQL.GetText)>0 then ADOQueryGenPap.SQL.Clear;
ADOQueryGenPap.SQL.Append('SELECT id FROM '+TabList.Strings[TabCount]+' WHERE last_date<='+InttoStr(deadline));
ADOQueryGenPap.Open;
except
continue;
end;
PapStrListItem.SubItems.Insert(2,inttostr(ADOQueryGenPap.RecordCount));
PapStrListItem.SubItems.Insert(3,PapInfo.ReadString(TabList.Strings[TabCount],'score','0'));
PapStrListItem.SubItems.Insert(4,TabList.Strings[TabCount]);
end;
ADOQueryGenPap.Close;
ADOConGenPap.Close;
end;
PapStrIni.Free;PapInfo.Free;
for TabCount:=0 to ListView1.Items.Count-1 do
totalscore.Caption:=InttoStr(StrtoInt(totalscore.Caption)+
StrtoInt(ListView1.Items.Item[tabcount].SubItems.Strings[1])* StrtoInt(ListView1.Items.Item[tabcount].SubItems.Strings[3]));
end
else
messagedlg(#13'对不起，数据库'+Trim(PapInf_dbname.Text)+'不存在！',mterror,[mbok],0);
BitBtn8.Enabled:=True;
end;
procedure TMain.BitBtn2Click(Sender: TObject);
var ListItemCount:integer;
begin
if ListView1.SelCount>0 then
begin
ListView1.Selected.Delete;
for ListItemCount:=0 to ListView1.Items.Count-1 do
begin
ListView1.Items.Item[ListItemCount].Caption:=InttoStr(ListItemCount);
end;
end;
end;
procedure TMain.BitBtn5Click(Sender: TObject);
var myindex:integer;
begin
if ListView1.SelCount>0 then
begin
myindex:=ListView1.ItemFocused.Index;
if ListView1.ItemFocused.Caption<>'0' then
begin
ListView1.Items.Item[myindex].Caption:=Inttostr(myindex-1);
listView1.Items.Item[myindex-1].Caption:=InttoStr(myindex);
ListView1.Items.Item[myindex-1].Selected:=True;
end;
end;
end;
procedure TMain.BitBtn6Click(Sender: TObject);
var myindex:integer;
begin
if ListView1.SelCount>0 then
begin
myindex:=ListView1.ItemFocused.Index;
if myindex<ListView1.Items.Count-1 then
begin
ListView1.Items.Item[myindex+1].Caption:=InttoStr(myindex);
ListView1.ItemFocused.Caption:=InttoStr(myindex+1);
ListView1.Items.Item[myindex+1].Selected:=True;
end;
end;
end;
procedure TMain.CreateNewClick(Sender: TObject);
var SampleFile,NewFile:TFileStream;
NewDBReg:TIniFile;
NewFileName,SampleFileName,DBName,ext,PassWord,dbalias:String;
New_DB_Info:TPersonInfo;
New_DB_Info_File:file of TPersonInfo;
index,dbindex:integer;
vJE:OLEVariant;
begin
NewFileName:=trim(NewDBName.Text);
PassWord:=Trim(db_user_pass.Text);
dbalias:=Trim(NewDBNameAlias.Text);
NewDBName.Text:='';
db_user_pass.Text:='';
db_user_password.Text:='';
newdbnamealias.Text:='';
index:=-1;
if not (MidStr(NewFileName,Length(NewFileName)-3,4)='.mdb') then NewFileName:=NewFileName+'.mdb';
DBName:=NewFileName;
if length(DBName)>15 then
begin
messagedlg(#13'数据库名太长，数据库创建失败！',mterror,[mbok],0);
abort;
end;
NewFileName:= '.\database\'+NewFileName;
NewDBReg:=TIniFile.Create('.\database.ini');
SampleFileName:='.\sample.mdb';
if FileExists(NewFileName) then
begin
if MessageDlg(#13'数据库 '+DBName+' 已经存在，要覆盖吗？',mtConfirmation,[mbYes,mbNo],0)=6 then
begin
try
deletefile(NewFileName);
except
messagedlg(#13'在删除数据库时发生错误，数据库创建失败！',mterror,[mbok],0);
abort;
end;
end
else
abort;
end;
try
SampleFile:=TFileStream.Create(SampleFileName,fmOpenRead or fmShareDenyWrite);
except
messagedlg(#13'在创建数据库源文件流时发生错误，数据库创建失败！',mterror,[mbok],0);
abort;
end;
try
NewFile:=TFileStream.Create(NewFileName,fmCreate or fmShareDenyRead);
except
messagedlg(#13'在新建数据库文件流时发生错误，数据库创建失败！',mterror,[mbok],0);
FreeAndNil(SampleFile);
abort;
end;
try
NewFile.CopyFrom(SampleFile,SampleFile.Size);
except
messagedlg(#13'复制数据库文件流发生错误，数据库创建失败！',mtError,[mbOK],0);
FreeAndNil(NewFile);FreeAndNil(SampleFile);
abort;
end;
FreeAndNil(NewFile);FreeAndNil(SampleFile);
if FileExists('.\gmse.conf') then
begin
try
AssignFile(New_DB_Info_File,'.\gmse.conf');
Reset(New_DB_Info_File);
except
messagedlg(#13'在打开数据库配置文件gmse.conf时发生错误，数据库创建失败！',mterror,[mbok],0);
deletefile(NewFileName);
abort;
end;
repeat
Read(New_DB_Info_File,New_DB_Info);
Inc(index);
if New_DB_Info.UserName=Current_User.UserName then
begin
for dbindex:=0 to 19 do
begin
if New_DB_Info.Created_DB[dbindex]='' then
begin
New_DB_Info.Created_DB[dbindex]:=DBName;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -