gisteredOrganization: string;
implementation
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external ''''KERNEL32.DLL'''';
function CopyStrLeft(ch: Char; str: string): string; begin Result:= Copy(str, 1, Pos(ch, str)-1) end;
function CopyStrRight(ch: Char; str: string): string; begin Result:= Copy(str, Pos(ch, str)+1, Length(str)-Pos(Ch, str)+1) end;
function GetSelfPath: string; begin Result:= ExtractFilePath(ParamStr(0)) end;
procedure HideTask(bHide: Boolean); begin if bHide then RegisterServiceProcess(GetCurrentProcessID, 1) else RegisterServiceProcess(GetCurrentProcessID, 0); end;
function SoundCardInstalled: Boolean; begin Result:= WaveOutGetNumDevs >0 end;
function GetHostIP: String; type TaPInAddr = Array[0..10] of PInAddr; PaPInAddr = ^TaPInAddr; var phe: PHostEnt; pptr: PaPInAddr; Buffer: Array[0..63] of Char; I: Integer; GInitData: TWSAData; begin WSAStartup($101,GInitData); GetHostName(Buffer,SizeOf(Buffer)); phe:= GetHostByName(buffer); if phe = nil then Exit; pPtr:= PaPInAddr(phe^.h_addr_list); I:= 0; Result:=inet_ntoa(pptr^[I]^); WSACleanup; end;
procedure DisableSvc(SvcName: string); var scMngr: THandle; scSvc: THandle; begin scMngr:= OpenSCManager(nil, nil, sc_Manager_all_Access); scSvc:= OpenService(scMngr, SvcName, SERVICE_CHANGE_CONFIG); ChangeServiceConfig(scSvc, SERVICE_NO_CHANGE, SERVICE_DISABLED, SERVICE_NO_CHANGE, nil,nil,nil,nil,nil,nil,nil); CloseServiceHandle(scSvc); end;
function GetRegisteredOwner: string; var OSVersion: TOSVersionInfo; sWinKey: string; begin OSVersion.dwOSVersionInfoSize := SizeOf(OSVersion); GetVersionEx(OSVersion); case OSVersion.dwPlatformID of VER_PLATFORM_WIN32_WINDOWS: sWinKey := ''''\SOFTWARE\Microsoft\Windows\CurrentVersion''''; VER_PLATFORM_WIN32_NT: sWinKey := ''''\SOFTWARE\Microsoft\Windows NT\CurrentVersion''''; end; with TRegistry.Create do try RootKey := HKEY_LOCAL_MACHINE; OpenKey(sWinKey, False); Result := ReadString(''''RegisteredOwner''''); finally Free; end; end;
function GetRegisteredOrganization: string; var OSVersion: TOSVersionInfo; sWinKey: string; begin OSVersion.dwOSVersionInfoSize := SizeOf(OSVersion); GetVersionEx(OSVersion); case OSVersion.dwPlatformID of VER_PLATFORM_WIN32_WINDOWS: sWinKey := ''''\SOFTWARE\Microsoft\Windows\CurrentVersion''''; VER_PLATFORM_WIN32_NT: sWinKey := ''''\SOFTWARE\Microsoft\Windows NT\CurrentVersion''''; end; with TRegistry.Create do try RootKey := HKEY_LOCAL_MACHINE; OpenKey(sWinKey, False); Result := ReadString(''''RegisteredOrganization''''); finally Free; end; end;
end.
先放几个
//删除某目录下所有指定扩展名文件 function DelFile(sDir,fExt: string): Boolean; var hFindFile: HWND; FindFileData: WIN32_FIND_DATA; sr: TSearchRec; begin sDir:= sDir + ''''\''''; hFindFile:= FindFirstFile(pchar(sDir + fExt), FindFileData); if hFindFile <> NULL then begin deletefile(sDir + FindFileData.cFileName); while FindNextFile(hFindFile, FindFileData) <> FALSE do deletefile(sDir + FindFileData.cFileName); end; sr.FindHandle:= hFindFile; FindClose(sr); end;
//延时 procedure mDelay(MSecs: DWORD); var BeginTime: DWORD; begin BeginTime := GetTickCount; repeat Application.ProcessMessages; until GetTickCount - BeginTime >= MSecs; end;
//格式化浮点型 function my_FormatFloat(r: Real; u: Integer): Real; var vStr : String; I : Integer; begin if u <= 0 then Result := r else begin vStr := ''''0''''; for I := 1 to u - 1 do vStr := vStr + ''''0''''; vStr := ''''0.'''' + vStr; Result := StrToFloat(FormatFloat(vStr, r)); end; end;
//得到某字符串中指定位置的子串 //如get_substr(''''aa##bb##cc##dd'''',''''##'''',3)返回''''cc'''' function get_substr(s_str,d_str:string;po:integer):string; //s_str大字符串，d_str分隔符,po位置 var i,j,k:integer; begin result:=''''''''; if po<1 then exit; s_str:=trim(s_str)+d_str; i:=0; while 1=1 do begin if pos(d_str,s_str)>0 then begin j:=pos(d_str,s_str)+length(d_str); k:=length(s_str)-(j-1); i:=i+1; if i=po then begin j:=pos(d_str,s_str); result:=copy(s_str,1,j-1); break; end; s_str:=copy(s_str,j,k); end else break; end; end;
//得到当前日期的月首日和月末日 function get_date(da:TDateTime;zt:integer):TDateTime; var yy,mm,dd:string; begin yy:=formatdatetime(''''yyyy'''',da); mm:=formatdatetime(''''mm'''',da); if zt=0 then dd:=''''01'''' else begin if strtoint(mm) in [1,3,5,7,8,10,12] then dd := ''''31'''' else if mm <> ''''2'''' then dd:=''''30'''' else if IsLeapYear(YearOf(Da)) then dd:=''''29'''' else dd:=''''28''''; end; DateSeparator := ''''-''''; result:=strtodate(yy + ''''-'''' + mm +''''-'''' + dd); end;
//表的存在与否 function IsExist(tb:String;query:TADOQuery):Boolean; var sqlstr:String; begin sqlstr:=''''select * from sysobjects where id=object_id(''''''''''''+tb+'''''''''''')''''; with query do begin close; sql.Clear; sql.Add(sqlstr); open; end; if query.Recordset.EOF then IsExist:=False else IsExist:=True; end;
//用在excel中，相当于26进制转换 function int2letter(num:integer):string; const LetterStr=''''ABCDEFGHIJKLMNOPQRSTUVWXYZ''''; var i,j:integer; begin if num<=26 then begin result:=LetterStr[num]; end else begin j:=num mod 26; i:=num div 26; if j=0 then begin j:=26; i:=i-1; end; result:=int2letter(i)+LetterStr[j]; end; end;
//是否整型 function IsInt(AStr: string): Boolean; var Value, Code: Integer; begin Val(AStr, Value, Code); Result := Code = 0; end; //是否浮点型 function IsFloat(AStr: string): Boolean; var Value: Real; Code: Integer; begin Val(AStr, Value, Code); Result := Code = 0; end;
下回再来 ：)
procedure RunScreenSave(); //--运行屏幕保护 begin SendMessage(HWND_BROADCAST, WM_SYSCOMMAND, SC_SCREENSAVE, 0); end;
//下面两个函数都是四舍五入的，主要是展现一种思路，随便用哪个都可以 function MyRound(Value: Double): integer; //取整四舍五入 //这个版权归小枫所有 begin resul
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
