Advertisement
ipsBruno

(Delphi) Check MMS Server Online

May 6th, 2012
382
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 3.87 KB | None | 0 0
  1. /*
  2.  *  Copyright (c) 2012 [iPs]TeaM
  3.  *  Bruno da Silva (email@brunodasilva.com)
  4.  *  Checar se servidor MMS (Microsoft Streaming) está online
  5.  *  Versão em PHP: http://pastebin.com/KbMb9ACP
  6.  *
  7.  * www.brunodasilva.com
  8.  * www.ips-team.forumeiros.com
  9. */
  10.  
  11. // TerminarProcesso por paulourio@gmail.com
  12. function TerminarProcesso(sFile: String): Boolean;
  13. var
  14.   verSystem: TOSVersionInfo;
  15.   hdlSnap,hdlProcess: THandle;
  16.   bPath,bLoop: Bool;
  17.   peEntry: TProcessEntry32;
  18.   arrPid: Array [0..1023] of DWORD;
  19.   iC: DWord;
  20.   k,iCount: Integer;
  21.   arrModul: Array [0..299] of Char;
  22.   hdlModul: HMODULE;
  23. begin
  24.   Result := False;
  25.   if ExtractFileName(sFile)=sFile then
  26.     bPath:=false
  27.   else
  28.     bPath:=true;
  29.   verSystem.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
  30.   GetVersionEx(verSystem);
  31.   if verSystem.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS then
  32.   begin
  33.     hdlSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  34.     peEntry.dwSize:=Sizeof(peEntry);
  35.     bLoop:=Process32First(hdlSnap,peEntry);
  36.     while integer(bLoop)<>0 do
  37.     begin
  38.       if bPath then
  39.       begin
  40.         if CompareText(peEntry.szExeFile,sFile) = 0 then
  41.         begin
  42.           TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID), 0);
  43.           Result := True;
  44.         end;
  45.       end
  46.       else
  47.       begin
  48.         if CompareText(ExtractFileName(peEntry.szExeFile),sFile) = 0 then
  49.         begin
  50.           TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID), 0);
  51.           Result := True;
  52.         end;
  53.       end;
  54.       bLoop := Process32Next(hdlSnap,peEntry);
  55.     end;
  56.     CloseHandle(hdlSnap);
  57.   end
  58.   else
  59.     if verSystem.dwPlatformId=VER_PLATFORM_WIN32_NT then
  60.     begin
  61.       EnumProcesses(@arrPid,SizeOf(arrPid),iC);
  62.       iCount := iC div SizeOf(DWORD);
  63.       for k := 0 to Pred(iCount) do
  64.       begin
  65.         hdlProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,false,arrPid [k]);
  66.         if (hdlProcess<>0) then
  67.         begin
  68.           EnumProcessModules(hdlProcess,@hdlModul,SizeOf(hdlModul),iC);
  69.           GetModuleFilenameEx(hdlProcess,hdlModul,arrModul,SizeOf(arrModul));
  70.           if bPath then
  71.           begin
  72.             if CompareText(arrModul,sFile) = 0 then
  73.             begin
  74.               TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid [k]), 0);
  75.               Result := True;
  76.             end;
  77.           end
  78.           else
  79.           begin
  80.             if CompareText(ExtractFileName(arrModul),sFile) = 0 then
  81.             begin
  82.               TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid [k]), 0);
  83.               Result := True;
  84.             end;
  85.           end;
  86.           CloseHandle(hdlProcess);
  87.         end;
  88.       end;
  89.     end;
  90. end;
  91.  
  92.  
  93. procedure TForm1.FormCreate(Sender: TObject);
  94. begin
  95.     // Deixar oculto
  96.     // http://www.brunodasilva.com.br/2012/01/delphi-deixar-programa-oculto.html
  97.    // Application.ShowMainForm := False;
  98.     //Form1.Visible := false;
  99.  
  100.     // Iniciar WindowsMediaPlayer conforme parametros dados pelo PHP
  101.     WindowsMediaPlayer1.URL :=  ParamStr(1);
  102.     WindowsMediaPlayer1.settings.mute := true;
  103.  
  104.  
  105. end;
  106.  
  107. procedure TForm1.WindowsMediaPlayer1Buffering(ASender: TObject; Start: WordBool);
  108. begin;
  109.     // Criar arquivo para checar se existe em php. Caso existir o servidor está online
  110.     filecreate(application.Name + 'servidorOnline');
  111.  
  112.     // Fechar programa
  113.     TerminarProcesso('Project1.exe'); // nome do processo
  114.     Application.Destroy;
  115.     Application.Terminate;
  116.     Abort;
  117. end;
  118.  
  119. procedure TForm1.WindowsMediaPlayer1Error(Sender: TObject);
  120. begin
  121.     // Caso der erro, fechar programa sem criar arquivo
  122.     TerminarProcesso('Project1.exe'); // nome do processo
  123.     Application.Destroy;
  124.     Application.Terminate ;
  125.     Abort;
  126. end;
  127. // Install component Windows Media Player Activex
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement