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上一页 [1] [2] [3] 下一页 |
