common.pas

作为服务

  systime.wYear   :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),1,4));
  systime.wMonth  :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),6,2));
  systime.wDay    :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),9,2));
  systime.wHour   :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),12,2));
  systime.wMinute :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),15,2));
  systime.wSecond :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),18,2));
  if SetLocalTime(systime) then result := true
  else result := false;

end;
////////////////////////////////////////////////////////////////////////////////
//  功能:   得到系统桌面窗体句柄
////////////////////////////////////////////////////////////////////////////////
function GetDesktopHand: THandle;
begin
  Result:=FindWindow('progman',nil);
  Result:=GetWindow(Result,GW_Child);
end;

////////////////////////////////////////////////////////////////////////////////
//  功能:  得到系统任务栏句柄
////////////////////////////////////////////////////////////////////////////////
function GetTrayHandle :THandle;
begin
  Result := FindWindow('Shell_TrayWnd',nil);
end;



////////////////////////////////////////////////////////////////////////////////
//  功能: 获取用户的最高权限
////////////////////////////////////////////////////////////////////////////////
function SetPrivilege(sPrivilegeName: string; bEnabled: boolean ): boolean;
var     TPPrev,TP :TTokenPrivileges;
        Token     :THandle;
        dwRetLen  :DWord;
begin
Result := False;
//opens the access token associated with a process.
OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,Token);
TP.PrivilegeCount := 1;
//retrieves the locally unique identifier (LUID) used on a specified system to
//locally represent the specified privilege name.
if( LookupPrivilegeValue(Nil,PChar( sPrivilegeName ),TP.Privileges[ 0 ].LUID ))then
    begin
        if (bEnabled) then //Give this privileges
            begin
                TP.Privileges[ 0 ].Attributes := SE_PRIVILEGE_ENABLED;
            end
        else
            begin //NOT Give this privileges
                TP.Privileges[ 0 ].Attributes := 0;
            end;

        dwRetLen := 0;
        //enables or disables privileges in the specified access token.
        Result := AdjustTokenPrivileges(Token,False,TP,SizeOf( TPPrev ),TPPrev,dwRetLen);
    end;
CloseHandle( Token );
end;

//////////////////////////////////////////////////////
//iFlags:
//下面一种情况必须被指定
// EWX_LOGOFF
// EWX_REBOOT
// EWX_SHUTDOWN
// 以下标记可以组合使用
// EWX_POWEROFF
// EWX_FORCE : terminate processes
//////////////////////////////////////////////////////
function WinExitInNT( iFlags : integer ) : boolean;
begin
Result := True;
if (SetPrivilege('SeShutdownPrivilege', True)) then
    begin
        if (not ExitWindowsEx( iFlags,0)) then
            Result := False;
        SetPrivilege('SeShutdownPrivilege', False )
    end
else
    Result := False;
end;


/////////////////////////////////////////////////////////////////////////////////
// 功能 ：将情报板播放列表中的颜色字符串转换成 TColor颜色值
/////////////////////////////////////////////////////////////////////////////////

function transferTColorToCCCStr(s:TColor):string;
var r,g,b:integer;
  ss:string;
begin

  ss:=  DecToHexEx(s,6) ;
  r := StrToInt('$'+copy(ss,5,2));
  g := StrToInt('$'+copy(ss,3,2));
  b := StrToInt('$'+copy(ss,1,2));
  result:= copy(inttostr(r+1000),2,3) +  copy(inttostr(g+1000),2,3) +copy(inttostr(b+1000),2,3)+'000';

end;


/////////////////////////////////////////////////////////////////////////////////
// 功能 ：将情报板播放列表中的颜色字符串转换成 TColor颜色值
/////////////////////////////////////////////////////////////////////////////////
function transferStrToTColor(s:string):TColor;
begin          
   if copy(s,1,9)='000000000' then
      Result := RGB(255,255,000)
   else
      result := RGB(strtoint(copy(s,1,3)),strtoint(copy(s,4,3)),strtoint(copy(s,7,3)));//
end;

procedure  StringToCharArray(str:string;var outstr: array of char)  ;
var i:integer;
begin

  for i := 1 to  length(str) do
  begin
    outstr[i-1] := str[i];
  end;

end;

///////////////////////////////////////////////////
function clearsubString(substr,str:string):string;
begin
  while pos(substr,str)>0 do
  begin
    delete(str,pos(substr,str),length(substr));
  end ;
  result := str;
end;
/////////////////////////////////////////////////////////////////////////////////
// 功能 ：将字符串根据分隔符转换到字符串数组中 
/////////////////////////////////////////////////////////////////////////////////
procedure  splitToList(sourceStr,splitStr:String; s:TStrings);
var
  p:integer;
  ss,items:string;
begin
  s.Clear;
  ss:= sourceStr;
  p :=   pos(splitStr,ss);
  while p>0 do
  begin
    items  := copy(ss,1,p-1) ;
    if  trim(items)<>'' then  s.Add(items);
    delete(ss,1,p+length(splitStr)-1);
    p :=  pos(splitStr,ss);
  end;
  if trim(ss)<>'' then s.Add(ss);
end;


/////////////////////////////////////////////////////////////////////////////////
// 功能 ：从情报板的播放列表中提取发送的图片名称和字符串
//\fk3232\C038000\c000000000255注意安全谨慎驾驶
/////////////////////////////////////////////////////////////////////////////////
function processCMSContent(sourceStr:TStrings;flag:integer):String;
var
   i,tpos:integer;
   s,sFile,temps:string;
begin
  result :='';
  for i :=0 to sourceStr.Count-1 do
  begin
    s:= sourceStr[i];
    temps:='';
    if Pos('\B',S)<>0 then
    begin
       sFile:='['+copy(S,Pos('\B',S)+2,3)+']';
    end;
    delete(s,1,Pos('\c',s)-2);

    while Pos('\c',s)>0 do
    begin
      //tpos:= ;
      if Pos('\f',s) <>0 then
        temps := temps+copy(s,Pos('\c',s)+14,Pos('\f',s)-Pos('\c',s)-14)
      else
        temps := temps+copy(s,Pos('\c',s)+14,length(s)-Pos('\c',s)-13);
      if length(s)>14 then delete(s,1,14)
      else if  length(s)=14 then delete(s,1,14)
      else delete(s,1,Pos('\c',s)-1);
    end;
    result := result +sFile+ temps+';';
  end;
end;


/////////////////////////////////////////////////////////////////////////////////
// 功能 ：
/////////////////////////////////////////////////////////////////////////////////
function processCMSLibToFile(cmslib:string) :String;
var
    sCMSList : TStringList;
begin
    sCMSList :=TStringList.create;
    splitToList(cmslib,#13#10,sCMSList) ;
    result := '[list]'+#13#10+'item_no='+inttostr(sCMSList.Count)+#13#10+cmslib;
end;




function IntToBin(intValue: integer): string;
var
  i,shlvalue:integer;
begin
  Result:='';
  if intvalue=0 then Result:='0';
  i:=0;
  shlvalue:= 1;
  while shlvalue<=intvalue do
  begin
    if (intValue and shlvalue)<>0 then
      Result:='1'+Result  else
      Result:='0'+Result;
    inc(i);
    shlvalue:= 1 shl i;
  end;
end;

function BinToInt(Binstr: string): integer;
var
  i,size:integer;
begin
  Size := Length(Binstr);
  Result := 0;
  for i := 1 to Size do
    if BinStr[i] = '1' then
    begin
      Result := Result + (1 shl (Size-i));
    end;
end;

//////////////////////////////////////////////////////////////////////////////
// 功能: 列举指定路径下的文件到字符串数组中
//////////////////////////////////////////////////////////////////////////////
procedure ListDirectoryPathAnyFile(FileList: Tstrings;DirectoryPath:string);
var
  sr: TSearchRec;
begin
  if FindFirst(DirectoryPath, $00000020, sr) = 0 then
  begin
    repeat
      begin
        if lowercase(getFileExtName(sr.Name))='bmp' then
           FileList.Add(sr.Name);
      end;
    until FindNext(sr)<>0;
  end;
  SysUtils.FindClose(sr);
end;

//系统热键注册与取消
//ShortCut(Word('C'), [ssShift]);  ssCtrl
function  RegSysHotKey(Handle:THandle):boolean;
var ShiftState:Cardinal;
begin
  HotKeyId := GlobalAddAtom('SYSTEMSET') - $C000;
  ShiftState:=ProcessShiftState([ssShift]);
  RegisterHotKey(Handle, hotkeyid, ShiftState  , Word('G'));
end;

function  UnRegSysHotKey(Handle:THandle):boolean;
begin
  UnRegisterHotKey(handle, HotKeyId);
end;

function ProcessShiftState(ss:TShiftState):Cardinal;
var
   ShiftState :Cardinal;
begin
  ShiftState:=0;
  if (ssShift in  ss) then
    ShiftState := ShiftState or MOD_SHIFT;
  if (ssCtrl in  ss) then
    ShiftState := ShiftState or MOD_CONTROL;
  if (ssAlt in  ss) then
    ShiftState := ShiftState or MOD_ALT;
  Result :=ShiftState;
end;

////////////////////////////////////////////////////////////////////////////////
//函数功能 ：图像旋转
//参数说明 : 输入参数 src源图，输出参数 Dst目标图  输入参数  angle旋转角度
////////////////////////////////////////////////////////////////////////////////
function  bmp_rotate(src:tbitmap;var Dst:tbitmap; angle:extended):boolean;
var
  c1x,c1y,c2x,c2y:integer;
  p1x,p1y,p2x,p2y:integer;
  radius,n:integer;
  alpha:extended;
  c0,c1,c2,c3:tcolor;

begin
  Dst.Width  := src.Width;
  dst.Height := src.Height ;
// Dst.Mask($00347302);
  Dst.TransparentColor :=$00347302;
   //将角度转换为PI值
  angle := (angle / 180) * pi;
   // 计算中心点，你可以修改它
  c1x := src.width div 2;
  c1y := src.height div 2;
  c2x := dst.width div 2;
  c2y := dst.height div 2;

   // 步骤数值number
  if c2x < c2y then
    n := c2y
  else
    n := c2x;
  dec (n,1);

   // 开始旋转
  for p2x := 0 to n do begin
    for p2y := 0 to n do begin
      if p2x = 0 then
        alpha:= pi/2
      else
        alpha := arctan2(p2y,p2x);
      radius := round(sqrt((p2x*p2x)+(p2y*p2y)));
      p1x := round(radius * cos(angle+alpha));
      p1y := round(radius * sin(angle+alpha));

      c0 := src.canvas.pixels[c1x+p1x,c1y+p1y];
      c1 := src.canvas.pixels[c1x-p1x,c1y-p1y];
      c2 := src.canvas.pixels[c1x+p1y,c1y-p1x];
      c3 := src.canvas.pixels[c1x-p1y,c1y+p1x];

      dst.canvas.pixels[c2x+p2x,c2y+p2y]:=c0;
      dst.canvas.pixels[c2x-p2x,c2y-p2y]:=c1;
      dst.canvas.pixels[c2x+p2y,c2y-p2x]:=c2;
      dst.canvas.pixels[c2x-p2y,c2y+p2x]:=c3;
    end;
    application.processmessages
  end;
  Result :=true;
end;

end.