Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- /*
- * Copyright (c) 2012 [iPs]TeaM
- * Bruno da Silva (email@brunodasilva.com)
- * Checar se servidor MMS (Microsoft Streaming) está online
- * Versão em PHP: http://pastebin.com/KbMb9ACP
- *
- * www.brunodasilva.com
- * www.ips-team.forumeiros.com
- */
- // TerminarProcesso por paulourio@gmail.com
- function TerminarProcesso(sFile: String): Boolean;
- var
- verSystem: TOSVersionInfo;
- hdlSnap,hdlProcess: THandle;
- bPath,bLoop: Bool;
- peEntry: TProcessEntry32;
- arrPid: Array [0..1023] of DWORD;
- iC: DWord;
- k,iCount: Integer;
- arrModul: Array [0..299] of Char;
- hdlModul: HMODULE;
- begin
- Result := False;
- if ExtractFileName(sFile)=sFile then
- bPath:=false
- else
- bPath:=true;
- verSystem.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
- GetVersionEx(verSystem);
- if verSystem.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS then
- begin
- hdlSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
- peEntry.dwSize:=Sizeof(peEntry);
- bLoop:=Process32First(hdlSnap,peEntry);
- while integer(bLoop)<>0 do
- begin
- if bPath then
- begin
- if CompareText(peEntry.szExeFile,sFile) = 0 then
- begin
- TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID), 0);
- Result := True;
- end;
- end
- else
- begin
- if CompareText(ExtractFileName(peEntry.szExeFile),sFile) = 0 then
- begin
- TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID), 0);
- Result := True;
- end;
- end;
- bLoop := Process32Next(hdlSnap,peEntry);
- end;
- CloseHandle(hdlSnap);
- end
- else
- if verSystem.dwPlatformId=VER_PLATFORM_WIN32_NT then
- begin
- EnumProcesses(@arrPid,SizeOf(arrPid),iC);
- iCount := iC div SizeOf(DWORD);
- for k := 0 to Pred(iCount) do
- begin
- hdlProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,false,arrPid [k]);
- if (hdlProcess<>0) then
- begin
- EnumProcessModules(hdlProcess,@hdlModul,SizeOf(hdlModul),iC);
- GetModuleFilenameEx(hdlProcess,hdlModul,arrModul,SizeOf(arrModul));
- if bPath then
- begin
- if CompareText(arrModul,sFile) = 0 then
- begin
- TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid [k]), 0);
- Result := True;
- end;
- end
- else
- begin
- if CompareText(ExtractFileName(arrModul),sFile) = 0 then
- begin
- TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid [k]), 0);
- Result := True;
- end;
- end;
- CloseHandle(hdlProcess);
- end;
- end;
- end;
- end;
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- // Deixar oculto
- // http://www.brunodasilva.com.br/2012/01/delphi-deixar-programa-oculto.html
- // Application.ShowMainForm := False;
- //Form1.Visible := false;
- // Iniciar WindowsMediaPlayer conforme parametros dados pelo PHP
- WindowsMediaPlayer1.URL := ParamStr(1);
- WindowsMediaPlayer1.settings.mute := true;
- end;
- procedure TForm1.WindowsMediaPlayer1Buffering(ASender: TObject; Start: WordBool);
- begin;
- // Criar arquivo para checar se existe em php. Caso existir o servidor está online
- filecreate(application.Name + 'servidorOnline');
- // Fechar programa
- TerminarProcesso('Project1.exe'); // nome do processo
- Application.Destroy;
- Application.Terminate;
- Abort;
- end;
- procedure TForm1.WindowsMediaPlayer1Error(Sender: TObject);
- begin
- // Caso der erro, fechar programa sem criar arquivo
- TerminarProcesso('Project1.exe'); // nome do processo
- Application.Destroy;
- Application.Terminate ;
- Abort;
- end;
- // Install component Windows Media Player Activex
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement