frm_main.~pas

站长您好

    begin
      sql.text := query;
      Open;
      first;
      com.Items.Clear;
      while (not eof) do
      begin
        zcrbh := fieldbyname(XSName).asstring;
        com.items.Add(zcrbh);
        next;
      end;
      Close;
    end;
  except
    if QryTemp.Active then QryTemp.close;
  end;
end;

procedure TFrmMain.Full_FilterCombobox(com: TComboBox; Query: string; zdcode,
  zdname: string);
var
  zcrbh: string;
begin
  try
    QryTemp.close;
    with QryTemp do
    begin
      sql.text := query;
      Open;
      first;
      com.Items.Clear;
      while (not eof) do
      begin
        zcrbh := fieldbyname(zdcode).asstring + #9 +
          fieldbyname(zdname).asstring;
        com.items.Add(zcrbh);
        next;
      end;
      Close;
    end;
  except
    if QryTemp.Active then QryTemp.close;
  end;
end;



function TFrmMain.GetFieldName(TableName, FieldCName: string): string;
var
  myquery: TAdoquery;
begin
  myquery := TAdoquery.Create(self);
  myquery.Connection := UseDB;
  myquery.SQL.Text := 'select FieldName from FieldSys where (TableName=''' +
    TableName + ''')and(FieldCName=''' + FieldCName + ''')';
  myquery.Open;
  if RecordCount(MyQuery) = 1 then
    result := myquery.fieldbyname('FieldName').Text
  else
    result := '';
  myquery.Close;
  myquery.Destroy;
end;

function TFrmMain.GetFieldCName(TableName, FieldName: string): string;
var
  myquery: TAdoquery;
begin
  myquery := TAdoquery.Create(self);
  myquery.Connection := UseDB;
  myquery.SQL.Text := 'select FieldCName from FieldSys where (TableName=''' +
    TableName + ''')and(FieldName=''' + FieldName + ''')';
  myquery.Open;
  if RecordCount(MyQuery) = 1 then
    result := myquery.fieldbyname('FieldCName').Text
  else
    result := '';
  myquery.Close;
  myquery.Destroy;
end;

function TFrmMain.ExecSQL(SQLstring: string): Boolean;
begin
  try
    QryTemp.SQL.Text := SQLstring;
    QryTemp.SQL.SaveToFile('C:\ErrQuery.txt');
    QryTemp.ExecSQL;
    Result := True;
  except
    Result := False;
    raise;
  end;

end;

function TFrmMain.GetFieldText(CmbText: string; I: Integer): string;
var
  T: integer;
begin
  if CmbText = '' then
    Result := ''
  else
  begin
    T := Pos(#9, CmbText);
    if i = 1 then
    begin
      Result := Trim(Copy(CmbText, 1, T - 1))
    end
    else
      Result := Trim(Copy(CmbText, T + 1, Length(CmbText)));
  end;
end;

function TFrmMain.IncludeValue(Value: string): Boolean;
begin
  Result := False;
  Value := '''' + Value + '''';
  if Pos(Value, RightsString) > 0 then
    Result := True;
end;

function TFrmMain.CheckComboBox(com: Tcombobox; ColCount: Integer;
  BeCheck: Boolean): string;
var
  checkstr: string;
  i: integer;
  flagpos: integer;
  ExistNum: integer;
  ExistList: TStringList;
begin
  result := Com.Text;
  checkstr := UpperCase(com.text);
  ExistList := TStringList.Create;
  if (checkstr = '') then Exit;

  ExistNum := 0;
  ExistList.Clear;
  for i := 0 to com.items.count - 1 do
  begin
    flagpos := pos(CheckStr, UpperCase(Com.Items.Strings[i]));
    if flagpos > 0 then
    begin
      result := Com.Items.Strings[i];
      ExistList.Add(Com.Items.Strings[i]);
      ExistNum := ExistNum + 1;
    end;
  end;

  if (ExistNum = 0) and (BeCheck) then
  begin
    Result := '';
    com.SetFocus;
    EXIT;
  end;
  if ExistNum >= 1 then
    if Becheck then
    else
    begin
      Result := Com.Text;
    end;
end;

function TFrmMain.setcomboboxtext(sstmp: string; com: Tcombobox): string;
var
  comcode: string;
  i: integer;
  flagpos: integer;
  checkstr: string;
begin
  if sstmp = '' then
    result := ''
  else
    result := trim(sstmp + ' & ');

  for i := 0 to com.items.count - 1 do
  begin
    checkstr := com.Items.Strings[i];
    flagpos := pos('&', checkstr);
    comcode := trim(copy(checkstr, 1, flagpos - 1));
    if sstmp = comcode then
    begin
      result := com.items.strings[i];
      exit;
    end;
  end;
end;

function TFrmMain.IsObjectActive(className: string): boolean;
var
  ClassID: TCLSID;
  Unknown: IUnknown;
begin
  try
    ClassID := ProgIDToClassID(ClassName);
    result := GetActiveObject(ClassID, nil, Unknown) = S_OK;
  except
    result := false;
  end;
end;

function TFrmMain.Sql(Sql: string): string;
var
  SqlStr: string;
begin
  SqlStr := trim(Sql);
  SqlStr := StringReplace(SqlStr, '''', '''''', [rfReplaceAll]);
  Result := SqlStr;
end;

function TFrmMain.GetStdDateStr(DateStr: string): string;
var
  str: string;
  yyyy, mm, dd: string;
begin
  str := trim(DateStr);
  try
    str := datetostr(strtodate(str));
  except
    showmessage(str + ' 非日期格式');
    Result := '';
    exit;
  end;
  Result := FormatDateTime('yyyy-mm-dd', StrToDate(DateStr));
end;

function TFrmMain.DateToCode(DateStr: string): string;
begin
  Result := stringreplace(DateStr, '-', '', [rfReplaceAll]);
end;

function TFrmMain.GetLastIdentify: Integer;
begin
  try
    QryTemp.Close;
    QryTemp.SQL.text := 'SELECT @@IDENTITY AS Identity';
    QryTemp.Open;
    Result := QryTemp.FieldByName('Identity').AsInteger;
  except
    Result := -1;
  end;
end;

function TFrmMain.RecordCount(Query: TAdoQuery): integer;
var
  i: integer;
  TpQuery: TAdoQuery;
begin
  TpQuery := TAdoQuery.Create(self);
  TpQuery.Connection := Query.Connection;
  TpQuery.SQL.Text := Query.SQL.Text;
  TpQuery.Open;
  TpQuery.First;
  i := 0;
  while TpQuery.Eof = false do
  begin
    i := i + 1;
    TpQuery.Next;
  end;
  Result := i;
  TpQuery.Close;
  TpQuery.Destroy;
end;

{增加LISTVIEW}
{数组的下标=LISTVIEW的子项数}

procedure TFrmMain.AddListView(TVarArray: array of string; VarCount: integer;
  var Lv: TListView);
var
  MyItems: TlistItem;
  i: integer;
begin
  myitems := lv.Items.Add;
  myitems.Caption := Tvararray[0];
  for i := 1 to varcount do
  begin
    myitems.SubItems.Add(tvararray[i]);
  end;
  myitems.Selected := true;
  myitems.MakeVisible(true);
end;

function TFrmMain.FullStrYh(Str: string): string;
var
  I: integer;
  Stemp: string;
  SValue1: string;
  Value1: string;
begin
  SValue1 := '';
  Value1 := str;
  i := pos('''', Value1);
  while i > 0 do
  begin
    Stemp := copy(Value1, 1, i - 1);
    SValue1 := SValue1 + Stemp + '''''';
    Delete(value1, 1, i);
    i := pos('''', Value1);
  end;
  SValue1 := SValue1 + Value1;
  Value1 := SValue1;
  Result := Value1;
end;

function TFrmMain.ConnectServer(ODBC: string): Boolean;
var
  Reg: TRegistry;
  OpenKey: string;
  LoginServer: Boolean;
  UserName, Password: string;
begin
  //判断数据源是否存在
  Reg := TRegistry.Create;
  OpenKey := '\Software\ODBC\ODBC.INI\' + ODBC;
  if Reg.OpenKey(OpenKey, false) = false then
  begin
    FrmLoginServer := TFrmLoginServer.Create(nil);
    FrmLoginServer.LbODBC.Caption := ODBC;
    FrmLoginServer.ShowModal;
  end;
  Reg.CloseKey;
  if Reg.OpenKey(OpenKey, false) = false then
  begin
    Result := false;
    Reg.CloseKey;
    Reg.Destroy;
    exit;
  end
  else
  begin
    UserName := Reg.ReadString('LastUser');
    Password := '';
    Reg.CloseKey;
    Reg.Destroy;
  end;
  //根据数据源连接服务器
  Frmlogin := TFrmlogin.Create(nil);
  Frmlogin.Show;
  Frmlogin.Update;
  if dbconnect(Frmlogin.Connection, ODBC, UserName, Password) then
  begin
    Frmlogin.LbUserName.Visible := true;
    Frmlogin.EdtUseName.Visible := true;
    Frmlogin.EdtUseName.SetFocus;
    Frmlogin.LbPassword.Visible := true;
    Frmlogin.EdtPass.Visible := true;
    Frmlogin.SBOk.Visible := true;
    Frmlogin.SBCancel.Visible := true;
    Frmlogin.LbConnect.Caption := '';
    Frmlogin.Update;
    UseDB := Frmlogin.Connection;
    Result := true;
  end
  else
  begin
    Frmlogin.Update;
    showmessage('登录失败!');
    Result := false;
    Frmlogin.Close;
  end;
end;

function TFrmMain.DbConnect(ADOConnection: TADOConnection; Odbc, DbUsername,
  DbPassword: string): Boolean;
begin
  with ADOConnection do
  begin
    close;
    ConnectionString := 'MSDASQL.1;Persist Security Info=False;User ID=''' +
      DbUsername + ''';Data Source=''' + Odbc + ''';Initial Catalog=''' + Odbc +
      '''';
    try
      Open;
      Result := true;
      exit;
    except
      Result := false;
      exit;
    end;
  end;
end;

function TFrmMain.LoginDB(UserName, Pass: string): Boolean;
begin
  try
    if not ((Username = 'sa0000') and (pass = 'sa0000')) then
    begin
      Result := false;
      QryTemp.Close;
      QryTemp.SQL.Text := ('select * from FuncRights where LoginPass='''
        + pass + ''' and LoginName=''' + UserName + '''');
      QryTemp.Open;
      while not QryTemp.Eof do
      begin
        Result := true;
        LoginName := UpperCase(UserName);
        LoginPass := pass;
        LoginId := QryTemp.FieldByName('UserId').asstring;
        RightsString := QryTemp.FieldByName('RightsValue').asstring;
        RightsGrade := QryTemp.FieldByName('RightSGrade').asstring;
        Exit;
      end;
    end
    else
    begin
      Result := true;
      QryTemp.Close;
    end;

  except
    if QryTemp.Active then QryTemp.Close;
    Result := False;
  end;
end;

procedure TFrmMain.InsStr(var Sql: string; Value1, Value2: string);
begin
  if Uppercase(value1) = 'NULL' then
    Sql := Sql + ' NULL' + Value2
  else
    Sql := Sql + '''' + FrmMain.FullStrYh(Value1) + '''' + Value2;
  if Value2 = '' then Sql := Sql + ')';
end;