sp_utils.pas

通过网关发手机短信

unit SP_Utils;

interface
uses
  SysUtils, Classes,  Controls, Menus, Windows, DB, DBClient,
  Variants, Provider, TypInfo, ExtCtrls, Tabs, ComCtrls, ActiveX;

procedure EnablePanelEx(APanel: TWinControl; AEnable: boolean; ANegClasses: array of TClass);
procedure EnablePanel(APanel: TWinControl; AEnable: boolean);

function cp(s: string): string;
function DatasetToCdsData2(ADataset: TDataset): OleVariant;
procedure IncStr(var s: string);
function Equa(v1, v2: Variant): boolean;
function ValueIn(AValue: Variant; AValueSet: array of Variant): boolean;
function StrInArray(AStr, AStrList: string): boolean;
function FieldIsNull(AField1, AField2: TField): TField;
function CheckFilterWordInSQL(ASQL: string; ARaise: boolean = false): boolean;

function StreamToOleVar(AStream: TStream): OleVariant;
procedure OleVarToStream(AValue: OleVariant; AStream: TStream);
procedure OleVarToBlob(AValue: OleVariant; AField: TBlobField);
function BlobToOleVar(AField: TBlobField): OleVariant;
procedure SlitOleVar(AValue: OleVariant; var ASize: integer; var AResult: OleVariant);
procedure DefFieldByObj(ADataset: TDataset; APropObj: TPersistent; AStrLen: integer = 200);
procedure FillRecordFromObj(AObj: TPersistent; ADataset: TDataset);
procedure FillObjFromRecord(AObj: TPersistent; AData: TDataset; AIgnFields: string = '');
function QtStringSeries(s: string): string;
function GetLinceseNo: string;
procedure UpdateFieldValues(AField: TField; AValue: Variant);
function GetDispFromDataset(AValue: variant; AKeyField, ADispField: TField): string;

function NC(s: string): string;
function DatasetToCdsData(ADataset: TDataset): OleVariant; overload;
procedure DatasetToCdsData(ADataset: TDataset; var AData: OleVariant); overload;

implementation
uses SelfFunc;

 function DatasetToCdsData(ADataset: TDataset): OleVariant;
begin
  DatasetToCdsData(ADataset, Result);
end;
procedure DatasetToCdsData(ADataset: TDataset; var AData: OleVariant);
var
  cds: TClientDataset;
  prd: TDatasetProvider;
begin
  cds := TClientDataset.Create(nil);
  prd := TDatasetProvider.Create(nil);
  try
    ADataset.Open;
    ADataset.First;   //对于TkbmMemtable，如果不执行First有时只能返回一条记录
    prd.DataSet := ADataset;
    cds.SetProvider(prd);
    cds.Open;
    AData := cds.Data;
  finally
    cds.Free;
    prd.Free;
  end;
end;

function NC(s: string): string;
begin
  Result := 'N' + cp(s);
end;

function QtStringSeries(s: string): string;
begin
  Result := StringReplace(s, ',', cp(','), [rfReplaceAll]);
  Result := #39 +Result + #39;
end;

function GetDispFromDataset(AValue: variant; AKeyField, ADispField: TField): string;
begin
  Result := '';
  if AKeyField.DataSet.Locate(AKeyField.FieldName, AValue, []) then
    Result := ADispField.AsString;
end;

procedure EnablePanelEx(APanel: TWinControl; AEnable: boolean; ANegClasses: array of TClass);
var
  i: integer;

  function _IsNegClass(AObject: TObject): boolean;
  var
    ii: integer;
    const
      AInnerNegs: array[0..1]of TClass = (TTabSheet, TPanel);
  begin
    Result := false;

    for ii := Low(AInnerNegs) to High(AInnerNegs) do
    if AObject is AInnerNegs[ii] then
    begin
      Result := true;
      Exit;
    end;

    if Length(ANegClasses) > 0 then
    for ii := Low(ANegClasses) to High(ANegClasses) do
    if AObject is ANegClasses[ii] then
    begin
      Result := true;
      Break;
    end;
  end;

begin
  for i := 0 to APanel.ControlCount - 1 do
  begin
    with TControl(APanel.Controls[i]) do
    begin
      if not _IsNegClass(APanel.Controls[i]) then
         Enabled := AEnable;
    end;
    if APanel.Controls[i] is TWinControl then
      EnablePanelEx(TWinControl(APanel.Controls[i]), AEnable, ANegClasses);
  end;
end;

procedure EnablePanel(APanel: TWinControl; AEnable: boolean);
begin
  EnablePanelEx(APanel, AEnable, []);
end;

procedure IncStr(var s: string);
var
  i: integer;
begin
  i := length(s);
  while (Ord(s[i]) >= 90) and (i > 1) do
  begin
    s[i] := '0';
    dec(i);
  end;
  inc(s[i]);
  while not (s[i] in (['0'..'9'] + ['A'..'Z'])) do inc(s[i]);
end;


function cp(s: string): string;
begin
  Result := QuotedStr(s);
end;

function Equa(v1, v2: Variant): boolean;
var
  s1, s2: string;
begin
  if VarIsNull(v1) then
    s1 := '' else s1 := v1;
  if VarIsNull(v2) then
    s2 := '' else s2 := v2;
  Result := (AnsiCompareText(s1, s2) = 0);
end;

function ValueIn(AValue: Variant; AValueSet: array of Variant): boolean;
var
  i: integer;
begin
  Result := false;
  for i := Low(AValueSet) to High(AValueSet) do
  begin
    Result := Equa(AValue, AValueSet[i]);
    if Result then
      Break;
  end;
end;

type
   TVarSize = record
     case AType: boolean of
      true:
        (Bytes: array[0..3] of Byte);
      false:
        (Value: integer);
    end;

procedure DefFieldByObj(ADataset: TDataset; APropObj: TPersistent;
   AStrLen: integer);
var
  pl: PPropList;
  i: integer;
  sProp, sPropAlias: string;
  ft: TFieldType;
  n, len: integer;
  t: TPersistent;
  AFieldDef: TFieldDef;
begin
//  New(pl);
  t := APropObj;
  n := TypInfo.GetPropList(t , pl);
  try
    ADataset.Close;
    ADataset.FieldDefs.Clear;
    for i := 0 to n  -1 do
    with ADataset.FieldDefs do
    begin
      sProp := pl[i]^.Name;
      if Length(sProp) > 31 then
        sProp := Copy(sProp, 1, 31);
      case pl[i]^.PropType^.Kind of
        tkInteger: ft := ftInteger;
        tkString:  ft := ftString;
        tkFloat:   ft := ftFloat;
        tkVariant: ft := ftVariant;
      else         ft := ftString;
    end;
    if ft = ftString then
      len := AStrLen
    else len := 0;
      if AnsiCompareText(pl[i]^.PropType^.Name, 'Boolean') = 0 then
      begin
        ft := ftBoolean;
        len := 0;
      end;

      if AnsiCompareText(pl[i]^.PropType^.Name, 'TDateTime') = 0 then
      begin
        ft := ftDateTime;
        len := 0;
      end;

      if AnsiCompareText(pl[i]^.PropType^.Name, 'TDate') = 0 then
      begin
        ft := ftDate;
        len := 0;
      end;

      Add(sProp, ft, len);
    end;
    ADataset.Open;
  finally
    FreeMemory(pl);
  end;
end;

procedure FillObjFromRecord(AObj: TPersistent; AData: TDataset; AIgnFields: string = '');
var
  i: integer;
begin
 AIgnFields := ',' + AIgnFields + ',';
  with AData do
  begin
    for i := 0 to Fields.Count - 1 do
    if not Fields[i].IsNull then
    if pos(',' + Fields[i].FieldName + ',', AIgnFields) <= 0 then    
    if TypInfo.GetPropInfo(AObj, Fields[i].FieldName) <> nil then
    begin
      try
        SetPropValue(AObj, Fields[i].FieldName, Fields[i].Value);
      except
      end;
    end;
  end;
end;

procedure FillRecordFromObj(AObj: TPersistent; ADataset: TDataset);
var
  i: integer;
begin
  with ADataset do
  begin
    Edit;
    for i := 0 to Fields.Count - 1 do
    if TypInfo.GetPropInfo(AObj, Fields[i].FieldName) <> nil then
    begin
      try
        Fields[i].Value := GetPropValue(AObj, Fields[i].FieldName);
      except
      end;
    end;
  end;
end;

procedure UpdateFieldValues(AField: TField; AValue: Variant);
var
  bk: TBookMark;
begin
  with AField.DataSet do
  begin
    bk := GetBookMark();
    DisableControls;
    try
      First;
      while not Eof do
      begin
        Edit;
        AField.Value := AValue;
        Post;
        Next;
      end;
    finally
      GotoBookMark(bk);
      FreeBookMark(bk);
      Enablecontrols;
    end;
  end;
end;

procedure SlitOleVar(AValue: OleVariant; var ASize: integer; var AResult: OleVariant);
var
  i: integer;
  b: Byte;
  VarSize: TVarSize;
begin
  ASize := 0;
  AResult := Null;
  if AValue = Null then
    Exit;
  try
    VarSize.AType := true;
    for i := 0 to 3 do
      VarSize.Bytes[i] := AValue[i];
    VarSize.AType := false;
    ASize := VarSize.Value;

   if ASize = 0 then
     Exit;

   AResult := VarArrayCreate([0, ASize - 1], varByte);
    for i := 0 to ASize - 1 do
      AResult[i] := AValue[i + 4];

  except
    ASize := 0;
  end;
end;

procedure OleVarToStream(AValue: OleVariant; AStream: TStream);
var
  st: TStream;
  pc: PChar;
  i, ASize: integer;
  b, n: Byte;
begin
  if VarIsNull(AValue) then
    Exit;
  st := AStream;
  pc := TVarData(AValue).VArray.Data;
  ASize := TVarData(AValue).VArray.ElementSize *
    TVarData(AValue).VArray.Bounds[0].ElementCount;
  st.Write(pc[0], ASize);
//  raise exception.Create(inttostr(vararrayhighbound(AValue, 1)));
  {
  GetMem(pc, ASize);
  ASize := VarArrayHighBound(AValue, 1) + 1;
  try
    for i := 0 to ASize - 1 do
    begin
      b := AValue[i];
      pc[i] := Chr(b);
    end;

    st.Write(pc[0], ASize);

  finally
    FreeMem(pc);
  end;
  }
end;

procedure OleVarToBlob(AValue: OleVariant; AField: TBlobField);
var
  st: TStream;
  b, n: Byte;
begin
  AField.DataSet.Edit;
  if VarIsNull(AValue) then
  begin
    AField.AsVariant := AValue;
    Exit;
  end;
  try
    st := TMemoryStream.Create;
    OleVarToStream(AValue, st);
    st.Position := 0;
    AField.LoadFromStream(st);
    n := (st.Size);
  finally
    st.Free;
  end;
end;

function StreamToOleVar(AStream: TStream): OleVariant;
var
  st: TStream;
  pc: PChar;
  i, ASize: integer;
  VarSize: TVarSize;
  v: OleVariant;
begin
  st := AStream;
  if st.Size <= 0 then
  begin
    Result := Null;
    Exit;
  end;
  ASize := st.Size;
  st.Position := 0;
  Result := VarArrayCreate([0, ASize -1], varByte);
  pc := TVarData(Result).VArray.Data;
  st.Read(pc[0], ASize);


 { GetMem(pc, ASize);
  try
    st.Position := 0;
    st.Read(pc[0], ASize);
    Result := VarArrayCreate([0, ASize -1], varByte);
    for i := 0 to ASize - 1 do
      Result[i] := Byte(pc[i]);


  finally
    FreeMem(pc);
  end;
 }
end;

function BlobToOleVar(AField: TBlobField): OleVariant;
var
  st: TStream;
begin
  Result := Null;
  if AField.IsNull then
    Exit;
  st := TMemoryStream.Create;
  AField.SaveToStream(st);
  try
    Result := StreamToOleVar(st);
  finally
    st.Free;
  end;
end;

function CheckFilterWordInSQL(ASQL: string; ARaise: boolean = false): boolean;
const
   AMax = 3;
   AFilters: array[0..AMax - 1] of string = ('Drop', 'Delete', 'Truncate');
var
   i, n: integer;
   st: TStrings;
   ADisWord: string;
begin
  Result := false;
  ASQL := Uppercase(ASQL);
  ADisWord := '';
  for i := 0 to AMax - 1 do
  begin
    n := Pos(Uppercase(AFilters[i]), ASQL);
    if n > 0 then
    begin
      Result := true;
      Break;
    end;
  end;
  if not Result then
    Exit;
  Result := false;
  st := TStringList.Create;
  try
    st.Delimiter := ' ';
    st.DelimitedText := ASQL;
    for i := 0 to AMax - 1 do
      if st.IndexOf(Uppercase(AFilters[i])) <> -1 then
      begin
        Result := true;
        ADisWord := AFilters[i];
        Break;
      end;
    finally
      st.Free;
    end;
  if Result and ARaise then
    raise Exception.Create('SQL语句中包含可能导致危险操作的关键字:'+ ADisWord);
end;

function DatasetToCdsData2(ADataset: TDataset): OleVariant;
var
  cds: TClientDataset;
  prd: TDatasetProvider;
begin
  cds := TClientDataset.Create(nil);
  prd := TDatasetProvider.Create(nil);
  try
    ADataset.First;
    prd.DataSet := ADataset;
    cds.SetProvider(prd);
    cds.Open;
    Result := cds.Data;
  finally
    cds.Free;
    prd.Free;
  end;
end;

function GetLinceseNo: string;
var
  dwIDESerial, dExt, n: DWORD;
  d1, d2, d3, d4: CARDINAL;
  sMachName: string;
  i: integer;
begin
  dwIDESerial := 0;
  GetVolumeInformation('C:\', nil, d1, @dwIDESerial, d2, d3, nil, d4);
  dExt := $AC6B785A;
  n := $8184D289;
  sMachName := GetMachineName;
  for i := 1 to Length(sMachName) do
    n := n + Ord(sMachName[i]);
  n := n shl (n mod 24);
  dwIDESerial := dwIDESerial xor n;
  dExt := dExt or n;
  Result := inttohex(dwIDESerial , 8) + '-' + inttohex(dExt, 8);
end;

function FieldIsNull(AField1, AField2: TField): TField;
begin
  if AField1.IsNull then
    Result := AField2
  else
    Result := AField1;  
end;

function StrInArray(AStr, AStrList: string): boolean;
begin
  // 判断一个元素是否存在一个逗号分隔的字串列表中，例如：2,23,ab,24,55f
  Result := Pos(',' + AStr + ',', ',' + AStrList + ',') > 0;
end;

end.