Jump to content

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

U.D.O. - I give as good as I get

Schimbare majora in domeniul bate...

Masina universala :)
 God's Crooked Lines(2022)

Mai nou, și poliția loc...

TAHITI ligue 1

Control polaritate motor dc 24v
 Problema tensiune Generator Ford ...

Protejare sunca

Cum se procedeaza daca jandarmii ...

Honor 70
 Accident cu auto fara RCA (fara p...

Probleme arzator Ferroli SUN P7

Recomandare telefon in jur de 150...

Întrebare despre banda de derulare
 

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: 131
  • Î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: 131
  • Î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: 131
  • Î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: 131
  • Î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

Chirurgia spinală minim invazivă Chirurgia spinală minim invazivă

Chirurgia spinală minim invazivă oferă pacienților oportunitatea unui tratament eficient, permițându-le o recuperare ultra rapidă și nu în ultimul rând minimizând leziunile induse chirurgical.

Echipa noastră utilizează un spectru larg de tehnici minim invazive, din care enumerăm câteva: endoscopia cu variantele ei (transnazală, transtoracică, transmusculară, etc), microscopul operator, abordurile trans tubulare și nu în ultimul rând infiltrațiile la toate nivelurile coloanei vertebrale.

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