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

📄 usyspub.pas

📁 已经投入使用的商业级管理系统：液化气管理系统。 附带全部源码
💻 PAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 
  m_nGerm := nGerm;
end;

procedure TMyField.SetValue( strFieldData:string );
begin
  m_strFieldData := trim( strFieldData );
  if m_eDataFieldType = DATA_DATETIME then
  begin
    m_dtFieldData := strTodatetime(m_strFieldData);
  end;
end;

procedure TMyField.SetValue( dFieldData:double );
begin
  m_dFieldData := dFieldData;
end;

function TMyField.CharValue():string;
var
  clErr:TCustomException;
begin
  try
    if  m_eDataFieldType <> DATA_CHAR then
    begin
      clErr := TCustomException.Create();
      clErr.SetErrMsg( 'Value of field is not String ' );
      raise clErr;
    end;
  except
    clErr.Free();
  end;
  Result := m_strFieldData;
end;

function TMyField.DoubleValue():double;
var
  clErr:TCustomException;
begin
  try
    if  m_eDataFieldType <> DATA_DOUBLE then
    begin
      clErr := TCustomException.Create();
      clErr.SetErrMsg( 'Value of field is not Double ' );
      raise clErr;
    end;
  except
    clErr.Free();
  end;
  Result := m_dFieldData;
end;
function TMyField.DatetimeValue():Tdatetime;
var
  clErr:TCustomException;
begin
  try
    if  m_eDataFieldType <> DATA_DATETIME then
    begin
      clErr := TCustomException.Create();
      clErr.SetErrMsg( 'Value of field is not Datetime ' );
      raise clErr;
    end;
  except
    clErr.Free();
  end;
  Result := m_dtFieldData;
end;
function TMyField.FieldName():string;
begin
  Result :=  m_strFieldName;
end;

function TMyField.FieldType():TDataFieldType;
begin
  Result := m_eDataFieldType;
end;

function TMyField.IsKey():boolean;
begin
  if m_nkey > 0 then
    Result := true
  else
    Result := false;
end;
function TMyField.IsGerm():boolean;
begin
  if m_nGerm > 0 then
    Result := true
  else
    Result := false;
end;
{TMyField End}
{TAdoRet start}
constructor TAdoRet.Create(var clconn:TAdoConnection);
begin
  m_clObjectList := TObjectList.Create();
  m_bEOF := false;
  m_bOpen := false;
  m_strTableName := '';
  m_clAdoQuery := TAdoQuery.Create(nil);
  m_clAdoCommit := TAdoQuery.Create(nil);
  m_clAdoCommit.Connection := clconn;
  m_clAdoQuery.Connection := clconn;
end;

destructor TAdoRet.destroy();
begin
  m_clAdoQuery.Free();
  m_clAdoCommit.Free;
  m_clObjectList.Clear;
  m_clObjectList.Free();
end;

procedure TAdoRet.InitFieldData();
var
  i,ncount:integer;
  eDataFieldType:TDataFieldType;
begin
  ncount := m_clObjectList.Count - 1;
  for i := 1 to ncount do
  begin
    eDataFieldType := TMyField( m_clObjectList.Items[i] ).m_eDataFieldType;
    case eDataFieldType of
    DATA_CHAR:
      TMyField( m_clObjectList.Items[i] ).SetValue('');
    DATA_DOUBLE:
      TMyField( m_clObjectList.Items[i] ).SetValue(0);
    else
    end;
  end;
end;

procedure TAdoRet.InitAdoRet( var clconn:TAdoConnection );
begin
  m_clObjectList := TObjectList.Create();
  m_bEOF := false;
  m_bOpen := false;
  m_strTableName := '';
  m_clAdoQuery := TAdoQuery.Create(nil);
  m_clAdoCommit := TAdoQuery.Create(nil);
  m_clAdoCommit.Connection := clconn;
  m_clAdoQuery.Connection := clconn;
end;

procedure TAdoRet.SetTableName( strTableName:string );
begin
  m_strTableName := strTableName;
end;

procedure TAdoRet.AddField( var clMyField:TMyField );
begin
  if assigned( m_clObjectList ) then
  m_clObjectList.Add( clMyField );
end;

function TAdoRet.IsEOF():boolean;
begin
  Result := m_bEOF;
end;

function TAdoRet.IsOpen():boolean;
begin
  Result := m_bOpen;
end;

procedure TAdoRet.MoveFirst();
begin
  m_clAdoQuery.First();
  FetchOneRow();
end;

procedure TAdoRet.MoveNext();
begin
  m_clAdoQuery.Next();
  if m_clAdoQuery.Eof = true then
  begin
    m_bEOF := true;
  end
  else
  begin
    FetchOneRow();
  end;
end;

procedure TAdoRet.FetchOneRow();
var
  ncount,i:integer;
  eDataFieldType:TDataFieldType;
  strFieldName:string;
begin
  if ( m_bEOF = false ) and ( m_bOpen = true ) then
  begin
    ncount := m_clObjectList.Count - 1;
    for i := 0 to ncount do
    begin
      eDataFieldType := TMyField( m_clObjectList.Items[i] ).FieldType();
      strFieldName := TMyField( m_clObjectList.Items[i] ).FieldName();
      case eDataFieldType of
      DATA_CHAR,DATA_DATETIME:
        TMyField( m_clObjectList.Items[i] ).SetValue( m_clAdoQuery.Fieldbyname(strFieldName).AsString );
      DATA_DOUBLE:
        TMyField( m_clObjectList.Items[i] ).SetValue( m_clAdoQuery.Fieldbyname(strFieldName).AsFloat );
      else
      end;
    end;
  end;
end;

procedure TAdoRet.Open( strWhere:string );
var
  strSql:string;
  e:TCustomException;
begin
  strSql := '';
  strSql := 'select * from ' + m_strTableName  + ' ' + strWhere ;
  if RunSql( m_clAdoQuery, strSql, 0 ) = false then
  begin
    m_bOpen := false;
    m_bEOF := false;
    try
      e := TCustomException.Create();
      e.SetErrMsg('从数据库取数据失败');
      raise e;
    except
      e.Free;
    end;
  end
  else
  begin
     if m_clAdoQuery.RecordCount > 0 then
     begin
      m_bOpen := true;
      m_bEOF := false;
      m_clAdoQuery.First();
      FetchOneRow();
     end
     else
     begin
      m_bOpen := false;
      m_bEOF := true;
     end;
  end;
end;

procedure TAdoRet.InsertRecord( );
var
  strSql:string;
  i,ncount:integer;
  eDataFieldType:TDataFieldType;
  e:TCustomException;
begin
  strSql := '';
  strSql := 'insert into ' + m_strTableName +'(';
  ncount := m_clObjectList.Count - 1;
  //Get FieldName;
  for i := 0 to ncount do
  begin
    if Not TMyField( m_clObjectList.Items[i] ).IsGerm() then
    begin
      if i<>ncount then
        strsql := strsql + TMyField( m_clObjectList.Items[i] ).FieldName() + ','
      else
        strsql := strsql + TMyField( m_clObjectList.Items[i] ).FieldName();
    end;
  end;
  strsql := strsql + ')values(';
  //Get FieldData;
  for i := 0 to ncount do
  begin
    if Not TMyField( m_clObjectList.Items[i] ).IsGerm() then
    begin
      eDataFieldType := TMyField( m_clObjectList.Items[i] ).FieldType();
      if i<>ncount then
      begin
        case eDataFieldType of
        DATA_CHAR,DATA_DATETIME:
          strsql := strsql + '''' + TMyField( m_clObjectList.Items[i] ).CharValue() + '''' + ',';
        DATA_DOUBLE:
          strsql := strsql + FloatToStr( TMyField( m_clObjectList.Items[i] ).DoubleValue()) + ',';
      else
      end;
      end
      else
      begin
        case eDataFieldType of
        DATA_CHAR,DATA_DATETIME:
          strsql := strsql + '''' + TMyField( m_clObjectList.Items[i] ).CharValue() + '''' ;
        DATA_DOUBLE:
          strsql := strsql + FloatToStr( TMyField( m_clObjectList.Items[i] ).DoubleValue());
        else
        end;
      end;
    end;
  end;
  strsql := strsql + ')';
  //Runsql
  if RunSql( m_clAdoCommit, strSql, 1 ) = false then
  begin
    try
      e := TCustomException.Create();
      e.SetErrMsg('Insert Record UnSucceed');
      raise e;
    except
      e.Free;
    end;
  end;
  //Repeat InitFieldData
  InitFieldData();
end;
{note:not update key}
procedure TAdoRet.UpdateRecord();
var
  strSql, strwhere:string;
  i,ncount:integer;
  eDataFieldType:TDataFieldType;
  e:TCustomException;
begin
  strSql := '';
  strwhere := '';
  strwhere := ' where ';
  strSql := 'Update ' + m_strTableName +' set ';
  ncount := m_clObjectList.Count - 1;
  for i := 0 to ncount do
  begin
    eDataFieldType := TMyField( m_clObjectList.Items[i] ).FieldType();
    if TMyField( m_clObjectList.Items[i] ).IsGerm() or TMyField( m_clObjectList.Items[i] ).IsKey() then
    begin
      case eDataFieldType of
      DATA_CHAR,DATA_DATETIME:
      begin
        strwhere := strwhere + TMyField( m_clObjectList.Items[i] ).FieldName()+ ' = ';
        strwhere := strwhere + '''' + TMyField( m_clObjectList.Items[i] ).CharValue() + '''' + ' and ';
      end;
      DATA_DOUBLE:
      begin
        strwhere := strwhere + TMyField( m_clObjectList.Items[i] ).FieldName()+ ' = ';
        strwhere := strwhere + FloatToStr( TMyField( m_clObjectList.Items[i] ).DoubleValue()) + ' and ';
      end;
      else
      end;
    end
    else
    begin
      if i<>ncount then
      begin
        case eDataFieldType of
        DATA_CHAR,DATA_DATETIME:
        begin
          strsql := strsql + TMyField( m_clObjectList.Items[i] ).FieldName()+ ' = ';
          strsql := strsql + '''' + TMyField( m_clObjectList.Items[i] ).CharValue() + '''' + ',';
        end;
        DATA_DOUBLE:
        begin
          strsql := strsql + TMyField( m_clObjectList.Items[i] ).FieldName()+ ' = ';
          strsql := strsql + FloatToStr( TMyField( m_clObjectList.Items[i] ).DoubleValue()) + ',';
        end;
        else
        end;
      end
      else
      begin
        case eDataFieldType of
        DATA_CHAR,DATA_DATETIME:
        begin
          strsql := strsql + TMyField( m_clObjectList.Items[i] ).FieldName()+ ' = ';
          strsql := strsql + '''' + TMyField( m_clObjectList.Items[i] ).CharValue() + '''';
        end;
        DATA_DOUBLE:
        begin
          strsql := strsql + TMyField( m_clObjectList.Items[i] ).FieldName()+ ' = ';
          strsql := strsql + FloatToStr( TMyField( m_clObjectList.Items[i] ).DoubleValue());
        end;
        else
        end;
      end;
    end;
  end;
  strwhere := LeftStr( strwhere, Length(strwhere) - 4 );
  strsql := strsql + strwhere;
  //Runsql
  if RunSql( m_clAdoCommit, strSql, 1 ) = false then
  begin
    try
      e := TCustomException.Create();
      e.SetErrMsg('Insert Record UnSucceed');
      raise e;
    except
      e.Free;
    end;
  end;
  //Repeat InitFieldData
  InitFieldData();
end;

procedure TAdoRet.ExecuteSQL( strsql:string );
var
  e:TCustomException;
begin
  if RunSql( m_clAdoCommit, strSql, 1 ) = false then
  begin
    try
      e := TCustomException.Create();
      e.SetErrMsg('Execute SQL UnSucceed');
      raise e;
    except
      e.Free;
    end;
  end;
end;

function TAdoRet.Find( const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions ): Boolean;
begin
  if m_clAdoQuery.Locate( KeyFields, KeyValues, Options ) then
  begin
    FetchOneRow();
    Result := true;
  end
  else
  Result := false;
end;
{TAdoRet end}
end.
123

⌨️ 快捷键说明

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