u_globalproc.pas

一个简单的学籍管理软件

unit U_GlobalProc; //  全局过程和函数

interface

uses
  SysUtils, Db, DBTables, Bde, ComCtrls, Forms, windows, Dialogs,
  Tabs, Classes, HDBGrids;

type
  ChangeRec = packed record
    szName: DBINAME; //   字段名
    iType: Word; //   主类型
    iSubType: Word; //   子类型
    iLength: Word; //   宽度
    iPrecision: Byte; //   小数位数
  end;

//  添加一个字段
//  TTable -- 数据表（必须以独占方式打开） Rec -- 字段数据
function AddField(Table: TTable; Rec: ChangeRec): Boolean;

//  插入多个字段
//  TTable -- 数据表（必须以独占方式打开） Rec -- 字段数据数组
//  AfterIndex -- 在第几个字段后添加
function InsertField(Table: TTable; Recs: array of ChangeRec; AfterIndex: integer): Boolean;

//  改变一个字段
//  TTable -- 数据表（必须以独占方式打开） Field -- 要改变的字段
//  Rec -- 新字段数据
function ChangeField(Table: TTable; Field: TField; Rec: ChangeRec): Boolean;

//  删除一个字段
//  TTable -- 数据表（必须以独占方式打开） Field -- 要删除的字段
function DropField(Table: TTable; Field: TField): Boolean;

//  显示提示信息框
procedure Show_InfoMess(Msg: string);

//  显示错误信息框
procedure Show_ErrorMess(Msg: string);

//  显示警告信息框
procedure Show_WarningMess(Msg: string);

//  显示确认信息框
function Show_ConfirmMess(Msg: string): Boolean;

//  删除目录以及其中的文件
function DelDirFile(DirName: string): Boolean;

//  转移目录以及其中的文件
function MoveDirFile(SDir, DDir: string): Boolean;

//  当月最大日期
function MaxDays(Year, Month: Word): Word;

//  带"0" 格式化数字
function IntFormatStr(aValue: integer; aCount: integer): string;

//  Grid 的表头、表尾附加信息框的取值事件过程
procedure GridInfoGetCaption(Sender: TObject; PgChapter, PageNumber: Integer; var Caption: string);

//  根据 GridStyles 变量刷新 Grid
procedure RefreshGridStyle(Sender: TObject);

//  生成年级树 aMode -- 0 基本   1 -- 扩展  2 -- 年级  HasBase -- 有单位的节点
procedure MakeGradeTree(aTreeView: TTreeView; aMode: integer; HasBase: Boolean);

//  刷新 Grid 的栏目
procedure RefreshGridColumns(MGrid: THDBGrid; TableName: string;
  GetEvent: TFieldGetTextEvent; SetEvent: TFieldSetTextEvent);

  //  刷新 DataSet 的 Field
procedure RefreshDataSetField(aGrid:THDBGrid;
  GetEvent: TFieldGetTextEvent; SetEvent: TFieldSetTextEvent);

//  设置 Grid 的栏目
procedure ReSetGridColumns(MGrid: THDBGrid; TableName: string;
  GetEvent: TFieldGetTextEvent; SetEvent: TFieldSetTextEvent);

//  Grid 双击
function GridDblClick(Sender: TObject): boolean;

//  Grid 键盘输入
function GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState): boolean;
//
procedure DataSetSetText(aGrid: THDBGrid; aField: TField; const Text: string);
//
procedure DataSetGetText(aGrid: THDBGrid; aField: TField; var Text: string; DisplayText: Boolean);

// 设置用户权限
procedure SetUserPower(UserCode: string);

// 读取当前考次
procedure GetCurExamCode;

implementation
uses IniFiles, HGrids, U_GlobalVar, Menus;
{
  iType 主类型
  fldUNKNOWN         = 0;
  fldZSTRING         = 1;               { Null terminated string
  fldDATE            = 2;               { Date     (32 bit)
  fldBLOB            = 3;               { Blob
  fldBOOL            = 4;               { Boolean  (16 bit)
  fldINT16           = 5;               { 16 bit signed number
  fldINT32           = 6;               { 32 bit signed number
  fldFLOAT           = 7;               { 64 bit floating point
  fldBCD             = 8;               { BCD
  fldBYTES           = 9;               { Fixed number of bytes
  fldTIME            = 10;              { Time        (32 bit)
  fldTIMESTAMP       = 11;              { Time-stamp  (64 bit)
  fldUINT16          = 12;              { Unsigned 16 bit integer
  fldUINT32          = 13;              { Unsigned 32 bit integer
  fldFLOATIEEE       = 14;              { 80-bit IEEE float
  fldVARBYTES        = 15;              { Length prefixed var bytes
  fldLOCKINFO        = 16;              { Look for LOCKINFO typedef
  fldCURSOR          = 17;              { For Oracle Cursor type
  fldINT64           = 18;              { 64 bit signed number
  fldUINT64          = 19;              { Unsigned 64 bit integer
  fldADT             = 20;              { Abstract datatype (structure)
  fldARRAY           = 21;              { Array field type
  fldREF             = 22;              { Reference to ADT
  fldTABLE           = 23;              { Nested table (reference)

  MAXLOGFLDTYPES     = 24;              { Number of logical fieldtypes

  iSubType  子类型
{ Sub Types (Logical) }

{ fldFLOAT subtype     实数型的子类型

  fldstMONEY         = 21;              { Money

{ fldBLOB subtypes     二进制子类型

  fldstMEMO          = 22;              { Text Memo
  fldstBINARY        = 23;              { Binary data
  fldstFMTMEMO       = 24;              { Formatted Text
  fldstOLEOBJ        = 25;              { OLE object (Paradox)
  fldstGRAPHIC       = 26;              { Graphics object
  fldstDBSOLEOBJ     = 27;              { dBASE OLE object
  fldstTYPEDBINARY   = 28;              { Typed Binary data
  fldstACCOLEOBJ     = 30;              { Access OLE object
  fldstHMEMO         = 33;              { CLOB
  fldstHBINARY       = 34;              { BLOB
  fldstBFILE         = 36;              { BFILE

{ fldZSTRING subtype    字符子类型

  fldstPASSWORD      = 1;               { Password
  fldstFIXED         = 31;              { CHAR type
  fldstUNICODE       = 32;              { Unicode

{ fldINT32 subtype  长整形子类型

  fldstAUTOINC       = 29;

{ fldADT subtype

  fldstADTNestedTable = 35;             { ADT for nested table (has no name)

{ fldDATE subtype
  fldstADTDATE       = 37;              { DATE (OCIDate ) with in an ADT

{ Paradox types (Physical)      Paradox 的主类型

  fldPDXCHAR         = $101;            { Alpha    (string)
  fldPDXNUM          = $102;            { Numeric
  fldPDXMONEY        = $103;            { Money
  fldPDXDATE         = $104;            { Date
  fldPDXSHORT        = $105;            { Short
  fldPDXMEMO         = $106;            { Text Memo       (blob)
  fldPDXBINARYBLOB   = $107;            { Binary data     (blob)
  fldPDXFMTMEMO      = $108;            { Formatted text  (blob)
  fldPDXOLEBLOB      = $109;            { OLE object      (blob)
  fldPDXGRAPHIC      = $10A;            { Graphics object (blob)
  fldPDXBLOB         = fldPDXMEMO;
  fldPDXLONG         = $10B;            { Long
  fldPDXTIME         = $10C;            { Time
  fldPDXDATETIME     = $10D;            { Time Stamp
  fldPDXBOOL         = $10E;            { Logical
  fldPDXAUTOINC      = $10F;            { Auto increment (long)
  fldPDXBYTES        = $110;            { Fixed number of bytes
  fldPDXBCD          = $111;            { BCD (32 digits)
  fldPDXUNICHAR      = $112;            { not supported yet
  }

//增加字段

function AddField(Table: TTable; Rec: ChangeRec): Boolean;
var
  Props: CURProps;
  hDb: hDBIDb;
  TableDesc: CRTblDesc;
  pFields: pFLDDesc;
  pOp: pCROpType;
  B: Byte;
begin
  Result := False;
  if not Table.Active then
    Exit;
  if not Table.Exclusive then
    Exit;

  if DbiSetProp(hDBIObj(Table.Handle), curxltMODE, Integer(xltNONE)) <> DBIERR_NONE then
    Exit;
  if DbiGetCursorProps(Table.Handle, Props) <> DBIERR_NONE then
    Exit;

  if (Props.szTableType <> szPARADOX) and (Props.szTableType <> szDBASE) then
    Exit;

  // 分配字段定义内存
  pFields := AllocMem((Table.FieldCount + 1) * sizeof(FLDDesc));
  // 分配操作定义内存
  pOp := AllocMem((Table.FieldCount + 1) * sizeof(CROpType));
  try
    Inc(pOp, Table.FieldCount);
    pOp^ := crAdd;
    Dec(pOp, Table.FieldCount);

    if DbiGetFieldDescs(Table.Handle, pFields) <> DBIERR_NONE then
      Exit;
    Inc(pFields, Table.FieldCount);
    if (Length(Rec.szName) > 0) then
      pFields^.szName := Rec.szName;
    if (Rec.iType > 0) then
      pFields^.iFldType := Rec.iType;
    if (Rec.iSubType > 0) then
      pFields^.iSubType := Rec.iSubType;
    if (Rec.iLength > 0) then
      pFields^.iUnits1 := Rec.iLength;
    if (Rec.iPrecision > 0) then
      pFields^.iUnits2 := Rec.iPrecision;
    Dec(pFields, Table.FieldCount);
    for B := 1 to Table.FieldCount do
    begin
      pFields^.iFldNum := B;
      Inc(pFields, 1);
    end;
    pFields^.iFldNum := 0;
    Dec(pFields, Table.FieldCount);

    FillChar(TableDesc, sizeof(TableDesc), #0);
    if DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)) <> DBIERR_NONE then
      Exit;

    StrPCopy(TableDesc.szTblName, Table.TableName);
    StrPCopy(TableDesc.szTblType, Props.szTableType);
    TableDesc.iFldCount := Table.FieldCount + 1;

    TableDesc.pecrFldOp := pOp;
    TableDesc.pFldDesc := pFields;
    Table.Close;
    if DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False) = DBIERR_NONE then
      Result := True;
  finally
    if (pFields <> nil) then
      FreeMem(pFields);
    if (pOp <> nil) then
      FreeMem(pOp);
  end;
end;

//插入一批字段

function InsertField(Table: TTable; Recs: array of ChangeRec; AfterIndex: integer): Boolean;
var
  Props: CURProps;
  hDb: hDBIDb;
  TableDesc: CRTblDesc;
  pFields: pFLDDesc;
  pOp: pCROpType;
  sFld, dFld: pFLDDesc;
  B, N: Byte;
begin
  Result := False;
  if not Table.Active then
    Exit;
  if not Table.Exclusive then
    Exit;

  if DbiSetProp(hDBIObj(Table.Handle), curxltMODE, Integer(xltNONE)) <> DBIERR_NONE then
    Exit;
  if DbiGetCursorProps(Table.Handle, Props) <> DBIERR_NONE then
    Exit;

  if (Props.szTableType <> szPARADOX) and (Props.szTableType <> szDBASE) then
    Exit;

  N := High(Recs) + 1;
  if N < 1 then
    Exit;
  if AfterIndex < 0 then
    AfterIndex := 0;
  if AfterIndex > Table.FieldCount then
    AfterIndex := Table.FieldCount;

  // 分配字段定义内存
  pFields := AllocMem((Table.FieldCount + N) * sizeof(FLDDesc));
  sFld := pFields;
  dFld := pFields;
  Inc(sFld, AfterIndex);
  Inc(dFld, AfterIndex + N);
  // 分配操作定义内存
  pOp := AllocMem((Table.FieldCount + N) * sizeof(CROpType));
  try
    if DbiGetFieldDescs(Table.Handle, pFields) <> DBIERR_NONE then
      Exit;
    Move(sFld^, dFld^, (Table.FieldCount - AfterIndex) *
      Sizeof(FLDDesc));
    for B := 1 to AfterIndex do
    begin
      pFields^.iFldNum := B;
      Inc(pFields, 1);
      Inc(pOp, 1);
    end;
    for B := AfterIndex + 1 to AfterIndex + N do
    begin
      if (Length(Recs[B - AfterIndex - 1].szName) > 0) then
        pFields^.szName := Recs[B - AfterIndex - 1].szName;
      if (Recs[B - AfterIndex - 1].iType > 0) then
        pFields^.iFldType := Recs[B - AfterIndex - 1].iType;
      if (Recs[B - AfterIndex - 1].iSubType > 0) then
        pFields^.iSubType := Recs[B - AfterIndex - 1].iSubType;
      if (Recs[B - AfterIndex - 1].iLength > 0) then
        pFields^.iUnits1 := Recs[B - AfterIndex - 1].iLength;
      if (Recs[B - AfterIndex - 1].iPrecision > 0) then
        pFields^.iUnits2 := Recs[B - AfterIndex - 1].iPrecision;
      pFields^.iFldNum := B;
      pOp^ := crAdd;
      Inc(pFields, 1);
      Inc(pOp, 1);
    end;

    for B := AfterIndex + N + 1 to Table.FieldCount + N do
    begin
      pFields^.iFldNum := B - N;
      pOp^ := crCopy;
      Inc(pFields, 1);
      Inc(pOp, 1);
    end;
//    pFields^.iFldNum := 0;
    Dec(pFields, Table.FieldCount + N);
    Dec(pOp, Table.FieldCount + N);

    FillChar(TableDesc, sizeof(TableDesc), #0);
    if DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)) <> DBIERR_NONE then
      Exit;

    StrPCopy(TableDesc.szTblName, Table.TableName);
    StrPCopy(TableDesc.szTblType, Props.szTableType);
    TableDesc.iFldCount := Table.FieldCount + N;

    TableDesc.pecrFldOp := pOp;
    TableDesc.pFldDesc := pFields;
    Table.Close;
    if DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False) = DBIERR_NONE then
      Result := True;
  finally
    if (pFields <> nil) then
      FreeMem(pFields);
    if (pOp <> nil) then
      FreeMem(pOp);
  end;
end;

// 修改字段

function ChangeField(Table: TTable; Field: TField; Rec: ChangeRec): Boolean;
var
  Props: CURProps;
  hDb: hDBIDb;
  TableDesc: CRTblDesc;
  pFields: pFLDDesc;
  pOp: pCROpType;
  B: Byte;
begin
  Result := False;
  if not Table.Active then
    Exit;
  if not Table.Exclusive then
    Exit;

  if DbiSetProp(hDBIObj(Table.Handle), curxltMODE, Integer(xltNONE)) <> DBIERR_NONE then
    Exit;
  if DbiGetCursorProps(Table.Handle, Props) <> DBIERR_NONE then
    Exit;

  if (Props.szTableType <> szPARADOX) and (Props.szTableType <> szDBASE) then
    Exit;

  // 分配字段定义内存
  pFields := AllocMem(Table.FieldCount * sizeof(FLDDesc));
  // 分配操作定义内存
  pOp := AllocMem(Table.FieldCount * sizeof(CROpType));
  try
    Inc(pOp, Field.Index);
    pOp^ := crMODIFY;
    Dec(pOp, Field.Index);