xeduser.pas

在查询汉字拼音首字母时需要取得汉字的拼音

    end else NetFileDir := '';
    ConfigMode := cmSession;
    AddStandardAlias(NameStr, Dirstr, 'PARADOX');
    Open;
  end;
end;

procedure SetDBPass(Table: TTable; PS: string);
var
  TblDesc: CRTblDesc;
  hDb: hDBIDb;
  O, M: Boolean;
begin
  O := Table.Active;
  M := Table.Exclusive;
  Table.Open;
  HDb := Table.Database.Handle;
//  Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
  Table.Close;
  Table.Exclusive := True;
  FillChar(TblDesc, SizeOf(CRTblDesc), 0);
  StrPCopy(TblDesc.szTblName, Table.TableName);
  StrCopy(TblDesc.szTblType, szPARADOX);
  StrPCopy(TblDesc.szPassword, Ps);
  TblDesc.bProtected := True;

  { 添加主口令到PARADOX表里}
  Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, FALSE));
   {添加一个新口令到SESSION}
  Table.Exclusive := M;
  Table.Active := O;
end;

procedure PackTable(Table: TTable);
var
  Props: CURProps;
  hDb: hDBIDb;
  TableDesc: CRTblDesc;
begin
  Table.Close;
  Table.Exclusive := True;
  Table.Open;
  HDb := Table.Database.Handle;
  DbiGetCursorProps(Table.Handle, Props);
  Table.Close;
  if (Props.szTableType = szPARADOX) then begin
    FillChar(TableDesc, sizeof(TableDesc), 0);
    StrPCopy(TableDesc.szTblName, Table.TableName);
    StrPCopy(TableDesc.szTblType, Props.szTableType);
    TableDesc.bPack := True;
    DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False);
  end;
end;

procedure PackTable(Name: string);
var
  Props: CURProps;
  hDb: hDBIDb;
  TableDesc: CRTblDesc;
  Table: TTable;
begin
  Table := TTable.Create(nil);
  Table.Exclusive := True;
  Name := ExpandFileName(Name);
  Table.TableName := Name;
  try
    Table.Open;
    HDb := Table.Database.Handle;
    DbiGetCursorProps(Table.Handle, Props);
    Table.Close;
    if (Props.szTableType = szPARADOX) then begin
      FillChar(TableDesc, sizeof(TableDesc), 0);
      StrPCopy(TableDesc.szTblName, Table.TableName);
      StrPCopy(TableDesc.szTblType, Props.szTableType);
      TableDesc.bPack := True;
      DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False);
    end;
  except
    TellME('因故无法整理数据库：' + Name);
  end;
  Table.Free;
end;

procedure PickStr(P: TColumn; tb: TTable; S: string);
var
  Opened: Boolean;
begin
  Opened := tb.Active;
  tb.Open;
  tb.First;
  tb.DisableControls;
  P.PickList.Clear;
  while not tb.eof do begin
    P.PickList.Add(tb[S]);
    tb.Next;
  end;
  tb.Active := Opened;
  tb.enableControls;
end;

function GetPass(S: string): Real;
var
  I: Word;
  T: Real;
begin
  T := 1.2345678;
  for i := 1 to Length(S) do T := T * Byte(S[I]);
  Result := T;
end;


procedure CloseMDI(H: THandle);
begin
  SendMessage(application.mainform.ClientHandle, WM_MDIDESTROY, H, 0);
end;

procedure GetPaper(List: TStrings);
type
  TPaperName = array[1..64] of Char;
  TPaperNames = array[0..0] of TPaperName;
  PPaperNames = ^TPaperNames;

  TPaper = Word;
  TPapers = array[0..0] of TPaper;
  PPapers = ^TPapers;
var
  Dev, Drv, Port: array[1..128] of Char;
  hDMode: THandle;
  pDMode: PDevMode;
  I, Num: Integer;
  PAPERNAMES: PPaperNames;
  PAPERS: PPapers;
begin
  Printer.GetPrinter(@Dev, @Drv, @Port, hDMode);
  if hDMode = 0 then Exit;
  pDMode := GlobalLock(hDMode);
  //获取纸张名称
  Num := DeviceCapabilities(@Dev, @Port, DC_PAPERNAMES, nil, nil);
  GetMem(PAPERNAMES, Num * Sizeof(TPaperName));
  DeviceCapabilities(@Dev, @Port, DC_PAPERNAMES, PChar(PAPERNAMES), nil);
  //获取纸张大小
  Num := DeviceCapabilities(@Dev, @Port, DC_PAPERS, nil, nil);
  GetMem(PAPERS, Num * Sizeof(TPaper));
  DeviceCapabilities(@Dev, @Port, DC_PAPERS, PChar(PAPERS), nil);
  for i := 0 to Num - 1 do List.AddObject(FormatFloat('000：', Papers^[i]) + PaperNames[i], TObject(Papers[i]));
  GlobalUnlock(hDMode);
end;

function GetLocPrint(var spSize, Wide, Leng: Integer; var spOrder: Boolean): Boolean;
type
//  TPaperName = array[1..64] of Char;
  TPaperName = String[64];
  TPaperNames = array[0..0] of TPaperName;
  PPaperNames = ^TPaperNames;
var
//  Dev, Drv, Port: array[1..128] of Char;
  Dev, Drv, Port: string[128];
  hDMode: THandle;
  pDMode: PDevMode;
begin
  Printer.GetPrinter(@Dev, @Drv, @Port, hDMode);
  if hDMode <> 0 then begin
    pDMode := GlobalLock(hDMode);
    if pDMode <> nil then begin
      spOrder := pDMode.dmOrientation = 1;
      spSize := pDMode.dmPaperSize;
      Wide := pDMode.dmPaperWidth;
      Leng := pDMode.dmPaperLength;
    end;
    GlobalUnlock(hDMode);
  end;
  Result := True;
end;

function SetLocPrint(spSize, Wide, Leng: Integer; spOrder: Boolean): Boolean; overload;
type
  TPaperName = array[1..64] of Char;
  TPaperNames = array[0..0] of TPaperName;
  PPaperNames = ^TPaperNames;
var
  Dev, Drv, Port: array[1..128] of Char;
  hDMode: THandle;
  pDMode: PDevMode;
begin
  Printer.PrinterIndex := Printer.PrinterIndex;
  Printer.GetPrinter(@Dev, @Drv, @Port, hDMode);
  if hDMode <> 0 then begin
    pDMode := GlobalLock(hDMode);
    if pDMode <> nil then begin
      if spOrder then
        pDMode.dmOrientation := DMORIENT_PORTRAIT
      else
        pDMode.dmOrientation := DMORIENT_LANDSCAPE;
      pDMode.dmPaperSize := spSize;
      pDMode.dmPaperLength := Leng;
      pDMode.dmPaperWidth := Wide;
      pDMode.dmMediaType := 1;
      pDMode.dmFields := pDMode.dmFields
        or dm_Orientation
        or dm_PaperSize
        or dm_PaperLength
        or dm_PaperWidth
        or dm_MediaType;
    end;
    GlobalUnlock(hDMode);
  end;
  Printer.PrinterIndex := Printer.PrinterIndex;
  Result := True;
end;

function GetLocPrint(PS: TStringList): Boolean;
type
  TPaperName = array[1..64] of Char;
  TPaperNames = array[0..0] of TPaperName;
  PPaperNames = ^TPaperNames;
var
  Dev, Drv, Port: array[1..128] of Char;
  hDMode: THandle;
  pDMode: PDevMode;
begin
  PS.Clear;
  Printer.GetPrinter(@Dev, @Drv, @Port, hDMode);
  if hDMode <> 0 then begin
    pDMode := GlobalLock(hDMode);
    if pDMode <> nil then begin
      PS.Add(Format('纸张=%d', [pDMode.dmPaperSize]));
      PS.Add(Format('宽度=%d', [pDMode.dmPaperWidth]));
      PS.Add(Format('长度=%d', [pDMode.dmPaperLength]));
      PS.Add(Format('方向=%d', [pDMode.dmOrientation]));
    end;
    GlobalUnlock(hDMode);
  end;
  Result := True;
end;

function SetLocPrint(PS: TStringList): Boolean;
type
  TPaperName = array[1..64] of Char;
  TPaperNames = array[0..0] of TPaperName;
  PPaperNames = ^TPaperNames;
var
  Dev, Drv, Port: array[1..128] of Char;
  hDMode: THandle;
  pDMode: PDevMode;
begin
  Printer.PrinterIndex := Printer.PrinterIndex;
  Printer.GetPrinter(@Dev, @Drv, @Port, hDMode);
  if hDMode <> 0 then begin
    pDMode := GlobalLock(hDMode);
    if pDMode <> nil then begin
      pDMode.dmPaperSize := StrToInt(PS.Values['纸张']);
      pDMode.dmPaperWidth := StrToInt(PS.Values['宽度']);
      pDMode.dmPaperLength := StrToInt(PS.Values['长度']);
      pDMode.dmOrientation := StrToInt(PS.Values['方向']);
      pDMode.dmMediaType := 1;
      pDMode.dmFields := pDMode.dmFields
        or dm_Orientation
        or dm_PaperSize
        or dm_PaperLength
        or dm_PaperWidth
        or dm_MediaType;
    end;
    GlobalUnlock(hDMode);
  end;
  Printer.PrinterIndex := Printer.PrinterIndex;
  Result := True;
end;

function GetSysPrint(var spSize, Wide, Leng: Integer; var spOrder: Boolean): Boolean;
var
  S3: Cardinal;
  P1: _PRINTER_INFO_2;
  DV: Devmode;
  Buffer: array[1..1200] of Byte;
begin
  S3 := 1000;
  spSize := 0;
  spOrder := True;
  if not GetPrinter(PrHandle, 2, @Buffer[1], S3, @S3) then
  begin
    Result := False;
    Exit;
  end;
  Move(Buffer[1], P1, Sizeof(P1));
  DV := P1.pDevMode^; //这里好多可以设置
  with DV do begin
    dmDriverExtra := 0;
    spSize := dmPaperSize;
    spOrder := dmOrientation = DMORIENT_PORTRAIT;
    Wide := dmPaperWidth;
    Leng := dmPaperLength;
  end;
  Result := True;
end;

function SetSysPrint(spSize, Wide, Leng: Integer; spOrder: Boolean): Boolean;
var
  S3: Cardinal;
  P1: _PRINTER_INFO_2;
  DV: Devmode;
  Buffer: array[1..1200] of Byte;
begin
  S3 := 1000;
  if not GetPrinter(PrHandle, 2, @Buffer[1], S3, @S3) then
  begin
    Result := False;
    Exit;
  end;
  Move(Buffer[1], P1, Sizeof(P1));
  DV := P1.pDevMode^; //这里好多可以设置
  with DV do begin
    dmDriverExtra := 0;
    dmPaperSize := spSize;
    dmPaperWidth := Wide;
    dmPaperLength := Leng;
    dmDitherType := DMDITHER_NONE;
    if spOrder then
      dmOrientation := DMORIENT_PORTRAIT
    else
      dmOrientation := DMORIENT_LANDSCAPE;
    dmFields := dmFields or dm_Orientation
      or dm_DitherType or dm_PaperSize;
//             or 67134991;//FFFF状态
    dmFields := 67134979; //初试状态
    dmFields := 67134991;
  end;
  P1.pDevMode^ := DV;
  Result := WinSpool.SetPrinter(PrHandle, 2, @Buffer[1], 0);
  if Result then Beep;
end;

function ENumPrint(S: TStrings): Boolean;
var
  Buffer: array[1..1200] of char;
  Reads, Num: DWord;
  PName: _PRINTER_INFO_1;
  I: Word;
begin
  Result := EnumPrinters(PRINTER_ENUM_LOCAL, nil, 1, @Buffer, 1000, Reads, Num);
  if not Result then exit;
  S.Clear;
  for i := 0 to Num - 1 do begin
    Move(Buffer[i * Sizeof(PName) + 1], PName, Sizeof(PName));
    S.Add(PName.pName);
  end;
end;

function PrintName;
var
  Buffer: array[1..1200] of char;
  Reads, Num: DWord;
  PName: _PRINTER_INFO_1;
begin
  EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 1, @Buffer, 1000, Reads, Num);
  Move(Buffer[1], PName, Sizeof(PName));
  Result := PName.pName;
end;

function PrintHandle: Cardinal;
var
  Hdl: Cardinal;
begin
  if OpenPrinter(PrintName, Hdl, nil) then
    Result := Hdl else Result := 0;
end;

function AbortPrint;
begin
  Result := WinSpool.SetPrinter(PrHandle, 0, nil, PRINTER_CONTROL_PURGE);
end;

function PrintState: Integer;
var
  S3: cardinal;
  P1: _PRINTER_INFO_2;
  DV: Devmode;
  Buffer: array[1..1200] of char;
  ST: Cardinal;
  S: string;
begin
  S3 := 1000;
  if not GetPrinter(PrHandle, 2, @Buffer[1], S3, @S3) then
  begin
    PrintState := 0;
    Exit;
  end;
  Move(Buffer[1], P1, Sizeof(P1));
  DV := P1.pDevMode^;
  if dv.dmSize = 0 then ;
  ST := P1.Status;
  case ST of
    PRINTER_STATUS_BUSY: S := 'AAAAA';
    PRINTER_STATUS_DOOR_OPEN: S := 'AAAAA';
    PRINTER_STATUS_ERROR: S := 'AAAAA';
    PRINTER_STATUS_INITIALIZING: S := 'AAAAA';
    PRINTER_STATUS_IO_ACTIVE: S := 'AAAAA';
    PRINTER_STATUS_MANUAL_FEED: S := 'AAAAA';
    PRINTER_STATUS_NO_TONER: S := 'AAAAA';
    PRINTER_STATUS_NOT_AVAILABLE: S := 'AAAAA';
    PRINTER_STATUS_OFFLINE: S := 'AAAAA';
    PRINTER_STATUS_OUT_OF_MEMORY: S := 'AAAAA';
    PRINTER_STATUS_OUTPUT_BIN_FULL: S := 'AAAAA';
    PRINTER_STATUS_PAGE_PUNT: S := 'AAAAA';
    PRINTER_STATUS_PAPER_JAM: S := 'AAAAA';
    PRINTER_STATUS_PAPER_OUT: S := 'AAAAA';
    PRINTER_STATUS_PAPER_PROBLEM: S := 'AAAAA';
    PRINTER_STATUS_PAUSED: S := 'AAAAA';
    PRINTER_STATUS_PENDING_DELETION: S := 'AAAAA';