⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 ufundserver.pas

📁 Delphi Com编程的简单例子
💻 PAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@V02').Value := V02;
      ParamByName('@V03').Value := V03;
      ParamByName('@V04').Value := V04;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    V01 := sp_Fund.Parameters.ParamByName('@V01').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.CardGrpDel(const V01: WideString;
  var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_008_del';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.CardGrpUpd(const V01, V02, V05: WideString;
  var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_008_Upd';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@V02').Value := V02;
      ParamByName('@V05').Value := V05;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.CardAdd(var V01: WideString; const V02: WideString;
  var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_009_Add';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@V02').Value := V02;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    V01 := sp_Fund.Parameters.ParamByName('@V01').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.CardDel(const V01: WideString; var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_009_del';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.CardUpd(const V01, V02, V03, V04, V05: WideString;
  V06, V07: Smallint; const V08: WideString; var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_009_Upd';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@V02').Value := V02;
      ParamByName('@V03').Value := V03;
      ParamByName('@V04').Value := V04;
      ParamByName('@V05').Value := V05;
      ParamByName('@V06').Value := V06;
      ParamByName('@V07').Value := V07;
      ParamByName('@V08').Value := V08;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.CardValAdd(const V01, V02, V03, V04: WideString;
  var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_009L_Add';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@V02').Value := V02;
      ParamByName('@V03').Value := V03;
      ParamByName('@V04').Value := V04;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.CardValDel(const V01: WideString;
  var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_009L_del';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.UserIPDel(const V01: WideString;
  var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_001L_del';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.UserIPAdd(const V01, V02: WideString;
  var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_001L_Add';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@V02').Value := V02;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.SysLogin(const LoginName, PWD: WideString;
  var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_SysLogin';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@LoginName').Value := LoginName;
      ParamByName('@PWD').Value := PWD;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.UserLogin(const LoginName, PWD, LabA, ValA, LabB,
  ValB, UCard, IPAdd: WideString; var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_Login';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@LoginName').Value := LoginName;
      ParamByName('@PWD').Value := PWD;
      ParamByName('@LabA').Value := LabA;
      ParamByName('@ValA').Value := ValA;
      ParamByName('@LabB').Value := LabB;
      ParamByName('@ValB').Value := ValB;
      ParamByName('@UCard').Value := UCard;
      ParamByName('@IPAdd').Value := IPAdd;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.SubSysLogin(const SubSysId, LoginName, PWD, LabA,
  ValA, LabB, ValB, UCard, IPAdd: WideString; var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_SubSysLogin';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@SubSysId').Value := SubSysId;
      ParamByName('@LoginName').Value := LoginName;
      ParamByName('@PWD').Value := PWD;
      ParamByName('@LabA').Value := LabA;
      ParamByName('@ValA').Value := ValA;
      ParamByName('@LabB').Value := LabB;
      ParamByName('@ValB').Value := ValB;
      ParamByName('@UCard').Value := UCard;
      ParamByName('@IPAdd').Value := IPAdd;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.QSysUser(const SysId, cSql: WideString;
  var vData: OleVariant);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'Q_SysUser1';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@SysId').Value := SysId;
      ParamByName('@FilterSql').Value := cSql;
    end;

    try
      //sp_Fund.ExecProc;
      cds_Qry.Active := true;
      vData := cds_Qry.XMLData;
    finally
      cds_Qry.Active := false;
      sp_Fund.Close;
      SetComplete;
    end;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.QNotSysUser(const SysId, cSql: WideString;
  var vData: OleVariant);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'Q_SysUser2';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@SysId').Value := SysId;
      ParamByName('@FilterSql').Value := cSql;
    end;

    try
      cds_Qry.Active := true;
      vData := cds_Qry.XMLData;
    finally
      cds_Qry.Active := false;
      sp_Fund.Close;
      SetComplete;
    end;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.UserToSys(const V01, V02: WideString;
  var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_004L2_Add1';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@V01').Value := V01;
      ParamByName('@V02').Value := V02;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TFundServer.Log(LogType: Smallint; const SubSysId, UserId,
  IpAddr: WideString; var lResult: Integer);
begin
  try
    if sp_Fund.Active = true then
      sp_Fund.Close;
    sp_Fund.ProcedureName := 'p_Log';
    sp_Fund.Parameters.Refresh;
    with sp_Fund.Parameters do
    begin
      ParamByName('@LogType').Value := LogType;
      ParamByName('@SubSysId').Value := SubSysId;
      ParamByName('@UserId').Value := UserId;
      ParamByName('@IpAddr').Value := IpAddr;
      ParamByName('@ret').Value := -1;
    end;
    sp_Fund.ExecProc;
    lResult := sp_Fund.Parameters.ParamByName('@ret').Value;
    sp_Fund.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

initialization
  TComponentFactory.Create(ComServer, TFundServer,
    Class_FundServer, ciMultiInstance, tmApartment);
end.
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -