wsutilsbak.pas

企业ERP管理系统

unit WSUtils;

interface

uses Windows, Messages, SysUtils, Classes, Controls, Forms, DBGrids, ComCtrls,
  DB, winsock, Dialogs, ADODB;

type
  TFlag = (Mouth, NotMouth, Number, Letter, AscII);

function GetMaxCode(Field: string; Table: string; Value: TFlag): string;
{ DONE -o 胡建平 -cCode :无限制编码,三个参数分别是Number(数字)/Letter(字母)/Ascii(数字+字母) }
function Coding(value: widestring; flag: tflag): string;
function GetPassword(AStrPass: string): integer; // 密码转换函数
function GetHostIP: string; //取得本机的IP地址函数
function GetComputerNameX: string; //取得计算机的名称函数
function FindShowForm(FormClass: TFormClass; const Caption: string): TForm;
function ColumnByFieldName(Grid: TDBGrid; const FieldName: string): TColumn;

{ 依据 DataSet 提供的数据建立树型结构，DataSet 必须包含 ID, Name, UpID 三个字段
  每个 TreeNode 的 Data 属性存储的是字段 ID 的值 }

  //注意:SourceDataSet中不能有既不是根节点又没有父节点的记录,否则不能退出该过程.
//  杨辉腾 2002.10.31
procedure BuildTreeFromDataSet(TreeItem: ttreenodes; SourceDataSet: TDataset);

//在TreeItem中查找ID等于UPID的节点,返回值nil为没找到,
//  杨辉腾 2002.10.31
function FindNode(TreeItem: TTreeNodes; UpId: integer): TTreeNode;

//存储Tree状态函数
function SaveState(Tree: TTreeView): Tstrings;


//重载Tree状态过程
procedure LoadState(tree: TTreeView; List: Tstrings);

{ 用关闭后再打开 DataSet 的方法来刷新 DataSet，并在打开后返回到以前状态(记录位置) }
procedure RefreshDataSet(DataSet: TDataSet);
procedure ExportDBGridToExcel(Grid: TDBGrid; DisableScreenUpdating: Boolean;
  ReportCaption, ReportMemo, ReportTtl :string);
function GetTempFileName(const FileName: string): string;
function GetCompanyName(): string;

procedure RunReportExplorer;

{ 打印报表，ReportName 制定要打印的报表名称  Screen Printer }   
procedure PrintReport(const ReportName, Params, DeviceType: string);

function NumberToHZ(Value: Extended; Style: Integer): string;

var
  PeriodID: integer; //管理期间ID
  CompanyName: string; //公司名称

implementation

uses ComObj, ActiveX, CommonDM, MSOption;

function GetCompanyName(): string;
var
  adoTemp: TADOQuery;
  c: string;
begin
  Screen.Cursor := CrHourglass;
  adoTemp := TADOQuery.Create(nil);
  adoTemp.Connection := CommonData.acnConnection;
  with adoTemp do
  begin
    close;
    sql.Text := 'Select top 1 * from MSCompanyUser where RecordState<>' + QuotedStr('删除');
    open;
    if RecordCount = 0 then
    begin
      //公司资料
      Application.CreateForm(TMSOptionForm, MSOptionForm);
      MSOptionForm.ShowModal;
      adoTemp.Requery();
    end;
    if RecordCount = 0 then
      result := ''
    else
      result := adoTemp.FieldByName('Name').AsString;
  end;
  Screen.Cursor := CrDefault;
end;

function FindForm(FormClass: TFormClass): TForm;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Screen.FormCount - 1 do begin
    if Screen.Forms[I] is FormClass then begin
      Result := Screen.Forms[I];
      Break;
    end;
  end;
end;

function InternalFindShowForm(FormClass: TFormClass;
  const Caption: string; Restore: Boolean): TForm;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Screen.FormCount - 1 do begin
    if Screen.Forms[I].ClassNameIs(FormClass.ClassName) then
      if (Caption = '') or (Caption = Screen.Forms[I].Caption) then begin
        Result := Screen.Forms[I];
        Break;
      end;
  end;
  if Result = nil then begin
    Application.CreateForm(FormClass, Result);
    if Caption <> '' then Result.Caption := Caption;
  end;
  with Result do begin
    if Restore and (WindowState = wsMinimized) then WindowState := wsNormal;
    Show;
  end;
end;

function FindShowForm(FormClass: TFormClass; const Caption: string): TForm;
begin
  Result := InternalFindShowForm(FormClass, Caption, True);
end;

function ColumnByFieldName(Grid: TDBGrid; const FieldName: string): TColumn;
var
  I: Integer;
begin
  for I := 0 to Grid.Columns.Count - 1 do
    if CompareText(Grid.Columns[I].FieldName, FieldName) = 0 then
    begin
      Result := Grid.Columns[I];
      Exit;
    end;
  Result := nil;
end;


procedure BuildTreeFromDataSet(TreeItem: ttreenodes; SourceDataSet: TDataset);
var
  i, Number: integer;
  temptree, Temptree2: ttreenode;
begin
  Number := SourceDataSet.Recordcount;

  while (not SourceDataSet.IsEmpty)
    and
    (treeitem.Count < SourceDataSet.RecordCount)
    and (Number > 0) do
  begin
    SourceDataSet.First;
    for i := 1 to SourceDataSet.RecordCount do
    begin
      if FindNode(treeitem, SourceDataSet.fieldbyname('ID').AsInteger) = nil //是否已经添加到Treeview
        then begin
        if (SourceDataSet.fieldbyname('UpID').AsInteger = -1)
          then begin
          temptree2 := treeitem.Add(nil, SourceDataSet.fieldbyname('Name').AsString);
          temptree2.data := pointer(SourceDataSet.fieldbyname('ID').asinteger);

        end
        else begin
          temptree := FindNode(treeitem, SourceDataSet.fieldbyname('UpID').AsInteger);
          if temptree <> nil //找到父节点
            then begin
            temptree2 := treeitem.AddChild(Temptree, SourceDataSet.fieldbyname('Name').AsString);
            temptree2.data := pointer(SourceDataSet.fieldbyname('ID').asinteger);
          end;
        end;

      end;
      Sourcedataset.Next;
    end;
    number := number - 1;
  end;

end;


function FindNode(TreeItem: TTreeNodes; UpId: integer): TTreeNode;
var
  i: integer;
begin
  result := nil;

  for i := 0 to treeitem.Count - 1 do
  begin
    if integer(treeitem.Item[i].Data) = Upid
      then result := treeitem.item[i]
  end;

end;


function SaveState(Tree: TTreeView): Tstrings;
var
  tempList: Tstrings;
  i: integer;
begin
  templist := TStringList.Create;
  templist.Clear;
  for i := 0 to tree.Items.Count - 1 do
  begin
    if tree.Items.Item[i].Selected
      then templist.Add(inttostr(i));
  end;
  result := templist;

end;

procedure LoadState(tree: TTreeView; List: Tstrings);
var
  i: integer;
begin
  for i := 0 to list.Count - 1 do
  begin
    if strtoint(list.Strings[i]) <= (tree.Items.Count - 1)
      then tree.Items.Item[strtoint(list.strings[i])].Selected := true;

  end;
end;


function GetPassword(AStrPass: string): integer;
{*******************************************************
描述:密码转换函数
版本: V1.0
日期:2002-11-01
作者: 胡建平
更新:
TODO:密码转换函数
*******************************************************}
var
  Temp: pchar;
  c: char;
  i, long, Pass: integer;
begin
  Pass := 0;
  long := Length(AStrPass);
  for i := 1 to Long do
  begin
    Temp := pchar(copy(AStrPass, i, 1));
    c := Temp^;
    if c in ['A'..'Z'] then
      c := chr(ord(c) + 32);
    Pass := Pass + (ord(c) xor long) + (ord(c) and long);
  end;
  Result := Pass;
end;

function GetComputerNameX: string;
{*******************************************************
描述:取得计算机的名称函数
版本: V1.0
日期:2002-11-01
作者: 胡建平
更新:
TODO:取得计算机的名称函数
*******************************************************}
var
  i: Cardinal;
  cBuff: PChar;
begin
  GetMem(cBuff, 128);
  i := 128;
  GetComputerName(cBuff, i);
  Result := StrPas(cBuff);
end;

////取得本机的IP地址

function GetHostIP: string;
{*******************************************************
描述:取得本机的IP地址函数
版本: V1.0
日期:2002-11-01
作者: 胡建平
更新:
TODO:取得本机的IP地址函数
*******************************************************}
var
  ch: array[1..32] of Char;
  i: Integer;
  WSData: TWSAData;
  MyHost: PHostEnt;
  IP: string;
begin
  IP := '';
  if WSAstartup(2, wsdata) <> 0 then
    Result := '0.0.0.0';

  try
    if getHostName(@ch[1], 32) <> 0 then
      Result := '0.0.0.0';
  except
    Result := '0.0.0.0';
  end;

  MyHost := GetHostByName(@ch[1]);
  if MyHost <> nil then
  begin
    for i := 1 to 4 do
    begin