udm.pas

Delphi学籍管理程序,以Delphi7.0为前台开发工具

unit uDM;

interface

uses
  SysUtils, Classes, DB, ADODB, Windows, Forms, IniFiles, Dialogs, CheckLst,
  Controls, Graphics, ExtDlgs, DBGridEh, ImgList, ComCtrls, FR_DSet,
  FR_DBSet, FR_Class;

type
  TDM = class(TDataModule)
    ADOConnection: TADOConnection;
    adSSCard: TADODataSet;
    dsSSCard: TDataSource;
    dsFamily: TDataSource;
    dsGrade: TDataSource;
    dsZXFL: TDataSource;
    dsGraduate: TDataSource;
    adSSCardXH: TWideStringField;
    adSSCardCreateDate: TDateTimeField;
    adSSCardMemo: TMemoField;
    adSSCardCurClass: TWideStringField;
    adSSCardName: TWideStringField;
    adSSCardSex: TWideStringField;
    adSSCardPeople: TWideStringField;
    adSSCardBirthday: TDateTimeField;
    adSSCardNative: TWideStringField;
    adSSCardMOT: TWideStringField;
    adSSCardRegKind: TWideStringField;
    adSSCardRegPS: TWideStringField;
    adSSCardAddress: TWideStringField;
    adSSCardAddPS: TWideStringField;
    adSSCardRAMR: TMemoField;
    adSSCardGSPhoto: TBlobField;
    adSSCardJHSPhoto: TBlobField;
    atFamily: TADOTable;
    atZXFL: TADOTable;
    atGraduate: TADOTable;
    atFamilyID: TAutoIncField;
    atFamilyXH: TWideStringField;
    atFamilyTitle: TWideStringField;
    atFamilyName: TWideStringField;
    atFamilyWorkPlace: TWideStringField;
    atFamilyBusiness: TWideStringField;
    atFamilyTel: TWideStringField;
    atZXFLID: TAutoIncField;
    atZXFLXH: TWideStringField;
    atZXFLEvent: TWideStringField;
    atZXFLEDate: TDateTimeField;
    atZXFLMemo: TWideStringField;
    atZXFLFillMan: TWideStringField;
    atGraduateID: TAutoIncField;
    atGraduateXH: TWideStringField;
    atGraduateCourse: TWideStringField;
    atGraduateGrade: TSmallintField;
    ImageListTree: TImageList;
    frReport: TfrReport;
    frSSCard: TfrDBDataSet;
    frFamily: TfrDBDataSet;
    frGrade: TfrDBDataSet;
    frZXFL: TfrDBDataSet;
    frGraduate: TfrDBDataSet;
    atGrade: TADOTable;
    atGradeID: TAutoIncField;
    atGradeXH: TWideStringField;
    atGradeGrade: TWideStringField;
    atGradeClass: TWideStringField;
    atGradeBegDate: TDateTimeField;
    atGradeEndDate: TDateTimeField;
    atGradeSchool: TWideStringField;
    atGradeSite: TWideStringField;
    atGradeAward: TWideStringField;
    procedure BeforeDelete(DataSet: TDataSet);
    procedure BeforeClose(DataSet: TDataSet);
    procedure DataModuleCreate(Sender: TObject);
    procedure adSSCardNewRecord(DataSet: TDataSet);
    procedure adSSCardAfterPost(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function OpenConnection(ConStr: string): Boolean;
function GetPassword: string;
procedure SetPassword(PSW: string);

procedure LoadGradeSetFromDB;
procedure SaveGradeSetToDB;
function GetClasses(ALevel, AGrade: string): string;
procedure SetClasses(ALevel, AGrade, AClasses: string);
procedure GetGradeCheck(ALevel: string; var AclbGrades: TCheckListBox);
procedure SetGradeCheck(ALevel: string; var AclbGrades: TCheckListBox);
procedure GetGradeTree;

function GetClassName(ClassNode: TTreeNode): string;

procedure MoveClass(ADataSet: TCustomADODataSet; BookmarkList: TBookmarkListEh;
  NewClassName: string);

function GetItemFromText(AText: string; Index: integer): string;
function GetIndexFromText(AText: string; Item: string): Integer;

procedure OpenClass(AClassName: string);

procedure SetPhotoToField(FieldName: string; ADataSet: TCustomADODataSet);
procedure ClearPhotoFromFeid(FieldName: string; ADataSet: TCustomADODataSet);

procedure ExportDataToExcel(AClassName: string; FileName: string);

var
  DM: TDM;

implementation

uses uGlobe;

{$R *.dfm}

function OpenConnection(ConStr: string): Boolean;
begin
  DM.ADOConnection.Close;
  DM.ADOConnection.ConnectionString := ConStr;
  try
    DM.ADOConnection.Open;
    Result := True;
  except
    MessageBox(Application.Handle, PChar('无法打开数据库, 请重新安装本软件.'), PChar('启动错误'), 48);
    Result := False;
    Exit;
  end;
end;

function GetPassword: string;
const
  Ini_Section_User = 'User';
begin
  with TIniFile.Create(IniFileName) do
  try
    Result := ReadString(Ini_Section_User, 'Password', '123456');
  finally
    Free;
  end;
end;

procedure SetPassword(PSW: string);
const
  Ini_Section_User = 'User';
begin
  with TIniFile.Create(IniFileName) do
  try
    WriteString(Ini_Section_User, 'Password', PSW);
  finally
    Free;
  end;
end;

procedure LoadGradeSetFromDB;
const
  SQL_Grade = 'SELECT Distinct gLevel, Grade FROM dClass ORDER BY gLevel, Grade';
  SQL_Class = 'SELECT class FROM dClass WHERE glevel=''%s'' AND grade=''%s'' ORDER BY class';
var
  aqGrade, aqClass: TADOQuery;
  GradeIni: TIniFile;
  Classes: TStrings;
begin
  if FileExists(ClassIniFileName) then DeleteFile(PChar(ClassIniFileName));

  aqGrade := TADOQuery.Create(nil);
  aqClass := TADOQuery.Create(nil);
  GradeIni := TIniFile.Create(ClassIniFileName);
  Classes := TStringList.Create;
  try
    Classes.Delimiter := gDelimiter;
    aqGrade.Connection := DM.ADOConnection;
    aqClass.Connection := DM.ADOConnection;

    aqGrade.SQL.Text := SQL_Grade;
    aqGrade.Open;
    while not aqGrade.Eof do begin

      aqClass.Close;
      aqClass.SQL.Text := format(SQL_Class, [
        aqGrade.FieldByName('glevel').AsString,
        aqGrade.FieldByName('Grade').AsString]);
      aqClass.Open;
      Classes.Clear;
      while not aqClass.Eof do begin
        Classes.Append(aqClass.FieldByName('Class').AsString);
        aqClass.Next;
      end;

      GradeIni.WriteString(
        aqGrade.FieldByName('glevel').AsString,
        aqGrade.FieldByName('Grade').AsString,
        Classes.DelimitedText);

      aqGrade.Next;
    end;
  finally
    FreeAndNil(Classes);
    FreeAndNil(GradeIni);
    FreeAndNil(aqClass);
    FreeAndNil(aqGrade);
  end;
end;

procedure SaveGradeSetToDB;
const
  SQL_SetTag = 'UPDATE dClass SET tag = False';
  SQL_SetDelGradeClasses = 'UPDATE dClass SET tag = True WHERE glevel=''%s'' AND grade=''%s'' ';
  SQL_SelectDelected = 'SELECT * FROM dClass WHERE tag = True';
  SQL_MoveDeleted = 'UPDATE SSCard SET CurClass = ''%S'' WHERE CurClass = ''%s''';
  SQL_DelGradeClasses = 'DELETE FROM dClass WHERE tag = True';
  SQL_Class = 'SELECT * FROM dClass WHERE glevel=''%s'' AND grade=''%s'' ORDER BY class';
var
  aqClass, aqCard: TADOQuery;
  GradeIni: TIniFile;
  Levels, Grades, Classes: TStrings;
  i, j: integer;
  tmpGrade: string;
  gGrades: string;
begin
  if not FileExists(ClassIniFileName) then exit;

  aqClass := TADOQuery.Create(nil);
  aqCard := TADOQuery.Create(nil);
  GradeIni := TIniFile.Create(ClassIniFileName);
  Levels := TStringList.Create;
  Grades := TStringList.Create;
  Classes := TStringList.Create;
  try
    aqCard.Connection := DM.ADOConnection;
    aqClass.Connection := DM.ADOConnection;
    aqClass.SQL.Text := SQL_SetTag;
    aqClass.ExecSQL;

    Classes.Delimiter := gDelimiter;
    GradeIni.ReadSections(Levels);

    for i:=0 to Levels.Count-1 do begin
      GradeIni.ReadSectionValues(Levels[i], Grades);
      for j:=0 to Grades.Count-1 do begin
        tmpGrade := Grades.Names[j];
        if Grades.Values[tmpGrade] = '' then begin
          //删除该年级所有班级
          aqClass.Close;
          aqClass.SQL.Text := format(SQL_SetDelGradeClasses, [Levels[i], tmpGrade]);
          aqClass.ExecSQL;
        end else begin
          aqClass.Close;
          aqClass.SQL.Text := format(SQL_Class, [Levels[i], tmpGrade]);
          aqClass.Open;

          Classes.DelimitedText := Grades.Values[tmpGrade];
          if aqClass.RecordCount > Classes.Count then begin
            //减少班级
            aqClass.Last;
            while aqClass.RecNo > Classes.Count do begin
              aqClass.Edit;
              aqClass.FieldByName('tag').AsBoolean := True;
              aqClass.Post;
              aqClass.Prior;
            end;
          end else begin
            //增加班级
            aqClass.Last;
            while aqClass.RecordCount < Classes.Count do begin
              aqClass.Append;
              aqClass.FieldByName('gLevel').AsString := Levels[i];
              aqClass.FieldByName('Grade').AsString := tmpGrade;
              aqClass.FieldByName('Class').AsString := Classes[aqClass.RecordCount];
              aqClass.Post;
            end;
          end;
        end;
      end;
    end;

    //todo: 设置已删除班级的学生到（未分班）中
    aqClass.Close;
    aqClass.SQL.Text := SQL_SelectDelected;
    aqClass.Open;

    aqClass.First;
    while not aqClass.Eof do begin
      if aqClass.FieldByName('gLevel').AsInteger = 1 then
        gGrades := ElementaryGrades
      else if aqClass.FieldByName('gLevel').AsInteger = 2 then
        gGrades := JuniorGrades
      else
        gGrades := '';

      aqCard.Close;
      aqCard.SQL.Text := format(SQL_MoveDeleted,
        [UnknowClass,
         format(ClassFormat,
           [GetItemFromText(gLevels, aqClass.FieldByName('gLevel').AsInteger-1),
            GetItemFromText(gGrades, aqClass.FieldByName('Grade').AsInteger-1),
            aqClass.FieldByName('Class').AsString
           ])
         ]);
      aqCard.ExecSQL;
      aqClass.Next;
    end;

    //真正删除班级
    aqClass.Close;
    aqClass.SQL.Text := SQL_DelGradeClasses;
    aqClass.ExecSQL;
  finally
    FreeAndNil(Classes);
    FreeAndNil(Grades);
    FreeAndNil(Levels);
    FreeAndNil(GradeIni);