Jump to content

SUBIECTE NOI
« 1 / 5 »
RSS
Info Coronavirus/Vaccinare vs Fake News

Trafo microunde

Tethering Telefon -Xbox series S ...

Boxa Portabila - buget ~1.500 RON
 Sisteme second hand

Laser circular basculant cu glisare

Permis suspendat - intrebare

Care a fost primul film din istor...
 Inlocuire bloc pedalier

Sa-i actionez in judecata?

Google Stadia se Închide

Sorin Cimpeanu și-a dat demi...
 Mailer Daemon-am fost blocat?

Port popular?

A murit Alexandru Arsinel.

Identificare boala vita de vie du...
 

Repetare cod

- - - - -
  • Please log in to reply
15 replies to this topic

#1
eugen55ro

eugen55ro

    Junior Member

  • Grup: Members
  • Posts: 41
  • Înscris: 18.07.2005
Salutare,

Se da urmatorul cod:

Private Sub Form_Load()
	IsCheckProcess ("calc.exe")
End Sub

Function IsCheckProcess(sAppName As String) As Boolean
 strComputer = "."
	Set objWMIService = GetObject("winmgmts:" _
		& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colProcesses = objWMIService.ExecQuery _
		("Select * from Win32_Process Where Name = '" & sAppName & "'")
	If colProcesses.Count = 0 Then
	 
		Shell ("C:\windows\System32\calc.exe")
		   
	Else
	
Daca este pornit sa se duca la prima linie si sa repete continuu

	End If

End Function


Multumesc anticipat

#2
msmihai

msmihai

    Senior Member

  • Grup: Senior Members
  • Posts: 5,259
  • Înscris: 02.09.2006
vrei sa spui ca trebuie sa faci o bucla do-while si nu stii cum? mda

Edited by msmihai, 14 August 2009 - 18:31.


#3
eugen55ro

eugen55ro

    Junior Member

  • Grup: Members
  • Posts: 41
  • Înscris: 18.07.2005
da, nu prea ma pricep la vb, incerc si eu asa cum pot :)

ideea este sa imi caute daca ruleze un program "calc.exe" in cazul de fata,

daca nu ruleaza sa-l porneasca, iar daca ruleaza sa repete oparatiunea continuu


Multumesc

#4
eugen55ro

eugen55ro

    Junior Member

  • Grup: Members
  • Posts: 41
  • Înscris: 18.07.2005
ma poate ajuta cineva?

Multumesc

#5
david2012

david2012

    Junior Member

  • Grup: Members
  • Posts: 85
  • Înscris: 29.07.2009
:deadtongue: Ai incercat sa folosesti un timer???

#6
eugen55ro

eugen55ro

    Junior Member

  • Grup: Members
  • Posts: 41
  • Înscris: 18.07.2005
As incerca, daca mi-ar spune cineva mai exact cum. Sa pun timer-ul in form stiu  :thumbup: , mai departe codul care trebuie trecut... nu stiu

#7
gabirds

gabirds

    Junior Member

  • Grup: Members
  • Posts: 129
  • Înscris: 09.10.2006

 eugen55ro, on 16th August 2009, 17:39, said:

As incerca, daca mi-ar spune cineva mai exact cum. Sa pun timer-ul in form stiu  :thumbup: , mai departe codul care trebuie trecut... nu stiu

o varianta fara timer...

Dim Opresc As Boolean
Dim MyApp As String

Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Public Sub Delay(DelaySeconds As Single)
  Dim T1 As Long
  T1 = GetTickCount()
  Do While GetTickCount() - T1 < CLng(DelaySeconds * 1000)
  DoEvents
  Loop
End Sub
Function IsCheckProcess(sAppName As String) As Boolean
If Opresc = True Then Exit Function
	strComputer = "."
	Set objWMIService = GetObject("winmgmts:" _
	& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colProcesses = objWMIService.ExecQuery _
	("Select * from Win32_Process Where Name = '" & sAppName & "'")
	If colProcesses.Count = 0 And MyApp <> "" Then
	Shell ("C:\windows\System32\" & MyApp)
	Else
	If MyApp = "" Then Exit Function
	Call Delay(2#)
	IsCheckProcess (MyApp)
	End If
	Exit Function
End Function

Private Sub Command1_Click()
	Opresc = True
	Set objWMIService = Nothing
	Set colProcesses = Nothing
	IsCheckProcess ("")
	MyApp = ""
		Unload Me
End Sub

Private Sub Form_activate()
	MyApp = "calc.exe"
	Do While Opresc = False
		IsCheckProcess (MyApp)
	Loop
	DoEvents
End Sub


#8
eugen55ro

eugen55ro

    Junior Member

  • Grup: Members
  • Posts: 41
  • Înscris: 18.07.2005
merge foarte bine, exact ce imi trebuie doar ca imi rupe procesorul :))

#9
gabirds

gabirds

    Junior Member

  • Grup: Members
  • Posts: 129
  • Înscris: 09.10.2006

 eugen55ro, on 18th August 2009, 21:32, said:

merge foarte bine, exact ce imi trebuie doar ca imi rupe procesorul :))

varianta cu timer, nu are asa pofta de mincare!! :naughty:

Dim MyApp As String

Function IsCheckProcess(sAppName As String) As Boolean
If Opresc = True Then Exit Function
	strComputer = "."
	Set objWMIService = GetObject("winmgmts:" _
	& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colProcesses = objWMIService.ExecQuery _
	("Select * from Win32_Process Where Name = '" & sAppName & "'")
	If colProcesses.Count = 0 And MyApp <> "" Then Shell ("C:\windows\System32\" & MyApp)
End Function

Private Sub Command1_Click()
	Set objWMIService = Nothing
	Set colProcesses = Nothing
		Unload Me
End Sub

Private Sub Form_activate()
	Timer1.Interval = 1000
	MyApp = "calc.exe"
End Sub

Private Sub Timer1_Timer()
	IsCheckProcess (MyApp)
End Sub


#10
eugen55ro

eugen55ro

    Junior Member

  • Grup: Members
  • Posts: 41
  • Înscris: 18.07.2005
asa da, merge perfect ;)
merci mult

o singura intrebare mai am (daca nu sar calul :) ) as putea adauga o linie ceva
sa imi faca un fisier .txt (log) sa vad cand a pornit calc.exe (in cazul asta) ?

sa imi pot da seama cam la ce intervale de timp crapa... daca sunt regulate

#11
gabirds

gabirds

    Junior Member

  • Grup: Members
  • Posts: 129
  • Înscris: 09.10.2006
ciao!

inlocuieste secventa "If colProcesses.Count = 0 And MyApp <> "" Then Shell ("C:\windows\System32\" & MyApp)"
cu urmatoarea:

	If colProcesses.Count = 0 And MyApp <> "" Then
	Shell ("C:\windows\System32\" & MyApp)
	Open "start.log" For Append As #1
	Print #1, Now 'poti pune Time, daca nu te intereseaza data
	Close #1
	End If

....si cu placere!!!

#12
eugen55ro

eugen55ro

    Junior Member

  • Grup: Members
  • Posts: 41
  • Înscris: 18.07.2005
gata l-am definitivat acum chiar e perfect :)
multumesc mult, esti foarte amabil
o sa caut si eu niste manuale sa ma apuc de invatat

multumesc inca o data  :thumbup:

#13
eugen55ro

eugen55ro

    Junior Member

  • Grup: Members
  • Posts: 41
  • Înscris: 18.07.2005
se pare totusi ca mai am inca o problema :(
procesul care trebuie verificat se numeste GameServer.exe
pana aici totul ok... il verifica vede cand se opreste
problema este la pornire, eu pentru a-l porni folosesc un shortcut la care am adaugat urmatoarele:
D:\GameServer\GameServer.exe 127.0.0.1 55970 127.0.0.1 55960 55901
daca nu il pornesc asa nu merge...
daca pun MyApp = "GameServer.lnk" nu merge :(
daca pun MyApp = "GameServer.exe 127.0.0.1 55970 127.0.0.1 55960 55901" la fel nu merge, il porneste dar nu cum trebuie :(
nu stiu cum sa fac...
daca ma mai poti ajuta putin ti-as fi recunoscator

multumesc anticipat

#14
gabirds

gabirds

    Junior Member

  • Grup: Members
  • Posts: 129
  • Înscris: 09.10.2006
sincer, nu stiiu!! :notangel:
eventual incearca sa pui separator un slash (/)
cam asa: ....MyApp & "/127.0.0.1 55970 127.0.0.1 55960 55901")

sau incearca -

uita-te in Properties in Ink, acolo cum arata comanda (Start in:.....)
poate mai ai si tu niste idei...

na, spor la treaba!!

#15
eugen55ro

eugen55ro

    Junior Member

  • Grup: Members
  • Posts: 41
  • Înscris: 18.07.2005
nu merge :(
am incercat toate variantele...

#16
rickysyv

rickysyv

    Senior Member

  • Grup: Senior Members
  • Posts: 2,620
  • Înscris: 08.03.2008
Incearca ShellExecute in loc de Shell.

Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOWNA = 8
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWDEFAULT = 10
Private Const SW_SHOW = 5
Private Const SW_NORMAL = 1
Private Const SW_HIDE = 0

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

ShellExecute Me.hwnd, vbNullString, "D:\GameServer\GameServer.exe", "127.0.0.1 55970 127.0.0.1 55960 55901", vbNullString, SW_SHOW

Ultimul parametru specifica cum vrei sa arate fereastra GameServer dupa ce e pornita aplicatia. Poti s-o pornesti minimizata, normala, maximizata sau cum vrei tu, alege constanta din lista aia.

Anunturi

Second Opinion Second Opinion

Folosind serviciul second opinion ne puteți trimite RMN-uri, CT -uri, angiografii, fișiere .pdf, documente medicale.

Astfel vă vom putea da o opinie neurochirurgicală, fără ca aceasta să poată înlocui un consult de specialitate. Răspunsurile vor fi date prin e-mail în cel mai scurt timp posibil (de obicei în mai putin de 24 de ore, dar nu mai mult de 48 de ore). Second opinion – Neurohope este un serviciu gratuit.

www.neurohope.ro

0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users

Forumul Softpedia foloseste "cookies" pentru a imbunatati experienta utilizatorilor Accept
Pentru detalii si optiuni legate de cookies si datele personale, consultati Politica de utilizare cookies si Politica de confidentialitate