Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VB.NET: Apua tarvitsisin. ( VB, Sendkeys ja textbox )

Sivun loppuun

laxative [30.01.2005 21:27:55]

#

Otsikko ei ollu kovin kuvaava, koska en vielä tiedä miksi tätä tekemääni juttua kutsutaan.

Asiaan... Tahtoisin tehdä eräänlaisen. Noh, flooderin tapaisen ohjelman. Sillä voisin vastata esim joihinkin tiettyihin emaileihin ja muihin pikaisesti. Turhaan mitään automaattivastaaaja laittamaan.

Elikkä, miten saan commandbuttonin lukemaan textboxista kirjoittamani tekstin ja sitten sendkeys toiminnolla kirjoittamaan sen johonkin valittuun kohteeseen..?

Jotain komentojakin voisi siihen laittaa. Esimerkiksi, jos kirjoittaa -winamp- textboxiin, niin se kyseinen commandbutton hakee ID3v2 tiedot winampista ja kirjoittaa ne samaisella sendkeys jutulla johonkin valittuun kohteeseen.

Toivottavasti en kysele liikoja. Juuri olen Visual Basicin harjoittelemisen aloittanut.

Elikkä lyhyesti. Commandbutton_click -> Hakee tiedot textboxista / Tunnistaa komennon ja hakee winampin tageista tiedot -> Kirjoittaa sen valittuun kohteeseen ( vaikka ohjelman ulkopuolelle )

Blaze [30.01.2005 21:55:34]

#

Kun kerran olet juuri aloittanut, niin kannattaa tutustua materiaaliin, jossa perusteita opetetaan, esimerkiksi Ohjelmointiputkan oppaat ovat käypää tavaraa.

TextBoxissa oleva teksti löytyy BoksinNimi.Text:stä, jota voit vertailla komentolistaa vastaan If -lauseilla tai Select Case -rakenteella, ja sitten voitkin SendKeyttää koko tavaran.

laxative [30.01.2005 22:04:44]

#

Kiitos pikaisesta vastauksesta!

Tiedän kyllä tuon BoksinNimi.Text jutun, mutta en piruvie sitä saa mitenkään järkäiltyä, miten sen sieltä saisi luettua ja kirjoitettua johonkin muualle.

Oppaitakin tuli luettua, kun visual basicin peruskurssi tuossa koulussa juuri käytiin läpi.

Blaze [30.01.2005 22:41:24]

#

No sitähän ei tarvitse tuolta erikseen hakea, voit käyttää tuota BoksinNimi.Text ilmaisua missä tahansa kohdassa, johon sopii muuttuja, esimerkiksi MsgBox MunLaatikko.Text

laxative [30.01.2005 22:51:38]

#

Tällä koodilla :

SendKeys (FLOODBAR.Text)
ADRESS.SetFocus

Saan siis kirjoitettua FLOODBAR :ssa olevan tekstin ADRESS kohtaan, mutta miten saan sen sitten kirjoittamaan sen tekstin mahdollisesti valittuna olevaan kohteeseen?

esakom [30.01.2005 23:23:22]

#

No jos valittu kohde on omassa ohjelmassasi, ja haluat että se teksti menee esim. valittuna olleeseen tekstikontrolliin,niin eräs ratkaisu joka tuli mieleen on:

1. Määrittelet formille globaalin muuttujan (eli laitat ihan alkuun esim: Dim k as Control

2. Lisäät jokaiselle tekstilaatikolle johon kirjoitusta haluat tukea LostFocus-tapahtuman, jossa tallennat kontrollin (Set k = kontrollin_nimi)

3. Komentonappulassa lähetät tekstin "k":lle, eli k.SetFocus

Esimerkkikoodi:

Dim k As Control

Private Sub address_LostFocus()
    Set k = address
End Sub

Private Sub Text1_LostFocus()
    Set k = Text1
End Sub

Private Sub Command1_Click()
    SendKeys (flood.Text)
    k.SetFocus
End Sub

En ole ihan varma oliko tämä mitä kysyit, jos on, toivottavasti auttaa. Jos valittu tekstilaatikko on jossain muusssa sovelluksessa, sitten joutuukin jo kikkailemaan...

laxative [31.01.2005 15:51:15]

#

No sanotaanko näin. Teen simppeliä nettiselainta.
Tarkoitus olisi siis textboxissa olevasta tekstistä lukea se teksti ja napin painalluksella kirjoittaa se valittuun kohteeseen WebBrowser1 :n

Testaan nyt toki tuota esimerkkiäsi, esakom.

tuomas [31.01.2005 16:14:20]

#

Et sä mitään nettiselainta tee, kun käytät tuota kontrollia. Sama p*ska ie siinä kontrollissa tulee, tietoturva-aukot mukanaan.

esakom [31.01.2005 17:40:45]

#

Jos siis olet ladannut tuohon WebBrowser1:een sivun jolla on tekstilaatikko johon haluat tekstin joka oli esim. text1:ssä, niin kyllä tuolla pitäisi onnistua. Kysy lisää jos on ongelmia.

laxative [31.01.2005 17:59:59]

#

Tuomas. Sinun ei tarvitse vastata viestiin, jossei haluta. ( Ainakaan mitään asiaan kuulumatonta. Mielipiteesi ei kiinnosta! )

Esakom:
Aivan aivan. Toimiihan se, jos esimerkiksi menen selaimellani googleen. Kyllähän se sinne sen hujauttaa, mutta nyt onkin kyse vähän tämmöisestä eri jutusta. Ei aiemmin kehdannut myöntää, mutta teen itselleni ja joillekkin nuoremmille kavereilleni ns. "habboselaimen", elikkä tuo teksti pitäisi saada kirjoitettua macromedia shockwavessa olevaan tekstikenttään. Olisiko mahdollista?

tuomas [31.01.2005 18:43:32]

#

No pyydän anteeksi, jos olin töykeä. Tuohon habbohotellin applettiin (tai on mikä on) ei voi viitata mitenkään helposti, koska se ei mikään vb:n kontrolli. Ja SendKeys:hän lähettää tekstiä aktiivisena olevaan alueseen joten sinun täytyisi saada tuo kyseinen kenttä aktivoitua. Se saattaisi ehkä onnistua etsimällä kentän kahva (hWnd) ja lähettämällä sille käskyjä.. ei mitään takuita että moinen on mahdollista (mutta tuollainen kyllä onnistuu perus-sovellukseen, paha mennä sanomaan tuollaisesta). Paljon esimerkkejä noiden kahvojen käytöstä löytyy mm. osoitteesta planetsourcecode.com (sekä muutamia aiheita ihan tuolla putkan haku ominaisuudella)

Puhveli [31.01.2005 18:49:33]

#

Käsittääkseni selain ei käytä tekstikenttien näyttämiseen Windows-objekteja vaan piirtelee ja ajaa objektit itse (tämän takia esim jossain Operassa on hienommat "commandbuttonit" kuin vinkussa). Tässä tapauksessa tekstikenttään olisi mahdotonta viitata ilman jotain selaimen omaa "takaporttia", koska sillä ei ole hWnd:tä.
edit: olin siis väärässä :p

laxative [31.01.2005 19:02:48]

#

Tuomas. Eipä mitän. :)

Tällä ohjelmalla tavallaan plagioin erästä toista ohjelmaa, jonka nimi on "MacroTool". Sen avulla voi lähettää viestejä ihan mihin tahansa, myös habboon.

Jos joku viitsisi vähän tsekata, niin tämä kyseinen "Macrotool" löytyy osoitteesta:
http://www.turska.org/habbo/MacroTool.zip
( En ole varma, onko tämä ohjelma tehty Visual Basicilla! )

Toisella "habboselaimellakin" on tehty winamp toiminto, joka kirjoittaa sendkeys toiminnolla winampissa olevan biisin ID tageista tiedot suoraan habbon omaan tekstikenttään ( ja muuallekkin )

esakom [31.01.2005 19:08:38]

#

Onko tilanne sellainen, että voit käskeä vb-ohjelmasi lähettämään komennon esim. viiden sekunnin kuluttua, ja käydä kyseisenä aikana aktivoimassa kohde-ikkunan? Jos on niin seuraava voisi toimia: Määrittele globaali osioon winapi-funktio:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sitten komentonapissa odotat ensin jonkun aikaa ja vasta sitten lähetät tekstin (tällä aikaa käyt aktivoimassa ikkunan)

Sleep (5000)  'aika on millisekuntia, tässä esim. 5000=5 sekuntia
SendKeys (Text1.Text)

Veikkaisin että tuo macrotool on tehty just tähän tyyliin, paitsi että sleepin sijasta odotetaan funktio-näppäintä ja sendkeys on ehkä voitu tehdä SendMessage tai PostMessage API:lla.

laxative [31.01.2005 19:37:21]

#

Yhden satunnaisen kerran tuo toimi, muuten se pätkäisee tasan tuon sleep komennon ajan ( elikkä vaikka tuo 5sek ) ...

Ongelmana on siis se, etten pysty valitsemaan mitään, jos tuo piruparka pätkäisee.

esakom [31.01.2005 20:02:29]

#

Mitä tarkoitat että pätkäisee? Kaatuu nurin vai jumittaa koneen vai? Tuo pitäisi olla sen verran yksinkertainen pätkä ettei pitäisi konetta sekoittaa. Onhan ohjelmointikielesi VB6? Mikä käyttis? (Tuskin on käyttiksestä kuitenkaan kiinni)

Blaze [31.01.2005 20:09:04]

#

Sleep käskee käyttistä keskeyttämään prosessin suorittamisen annetuksi ajaksi. Tuona aikana sun softa ei tee yhtikäs mitään, ei vastaa edes käyttiksen viesteihin, käyttäjän laukaisemista tapahtumista nyt puhumattakaan.

Sleep ei siis oikein sovellu tuohon tarkoitukseen, käytä Timeria.

esakom [31.01.2005 20:11:35]

#

Luulin että paikka minkä haluat aktivoida on toisessa sovelluksessa ja ikkunassa, eli tuossa mainitusssa shockwavessa.

Jos nyt ei niin sitten tuolla timerilla niinkuin Blaze sanoi.

laxative [31.01.2005 20:51:32]

#

Olen nyt vähän sekaisin. Timerilla sain tehtyä jonkinlaisen date / time jutun tuohon aiemmin, mutta mitenköhän tässä soveltaisin tuota mokomaa työkalua?

esakom [31.01.2005 21:11:41]

#

1. Lisää formille timerin (jos ei ole jo)
2. Asetat sen Interval arvoksi halutun ajan (taas millisekuntia) ja Enabled = False (properties-ikkuna)
3. Komentopainikkeeseen (tai vastaavaan josta haluat komennon antaa) lisäät komennon : Timer1.Enabled = True (lähtee laskemaan sitä aikaa minkä annoit)
Timerin koodiin (pääset siihen kun tuplaklikkaat sitä timeria formilla)

Private Sub Timer1_Timer()
    SendKeys (Text1.Text) 'Text1 on sen laatikon nimi mistä tekstiä lähetät
    Timer1.Enabled = False 'laitat timerin pois päältä (muuten tämä pamauttaa lisää tekstiä aina viiden sekunnin välein)
End Sub

laxative [31.01.2005 21:43:39]

#

Hiphei. Toimimaan rupes. Ei ihan se mitä hain ( painallus ja teksti ilmestyy ), mutta kyllä sitä jaksaa itse aktivoida sen ruudun mihin tuo teksti kirjoitetaan. Kiitos avusta kaikille! :)

Muutes ... Miten teen, jos minulla on tähän asiaan liittyvä ( winampjuttu ) ? ... Teenkö uuden postauksen vai kysynkö suoraan tässä? :)

esakom [31.01.2005 21:46:11]

#

Jos meinaat kysyä kappaleen hakemisesta, niin tässä tulee:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Const lpClassName = "Winamp v1.x"
Private Const strTtlEnd = " - Winamp"

Private Function HaeWinampKappale() As String
    Dim hwnd As Long
    hwnd = FindWindow(lpClassName, vbNullString)    'etsitään winamp

    Dim lpText As String * 100

    If hwnd = 0 Then    'ei löytynyt
        HaeWinampKappale = "Ei kappaletta"
        Exit Function
    End If

    Dim intLength As Integer
    intLength = GetWindowText(hwnd, lpText, Len(lpText))

    If (intLength <= 0) Or (intLength > Len(lpText)) Then   'ei onnistunut
         HaeWinampKappale = "Tuntematon"
         Exit Function
    End If

    Dim strTitle As String  'oletetaan että onnistui
    strTitle = Mid$(lpText, 1, intLength)

    'otetaan vielä mahdollisesti ylimääräinen Winamp teksti lopusta pois
    Dim winampViiva As Integer
    winampViiva = InStr(1, strTitle, strTtlEnd, vbTextCompare)
    If winampViiva > 1 Then
        strTitle = Left$(strTitle, winampViiva)
    End If

    HaeWinampKappale = Trim$(strTitle)

End Function

sitten vain kutsut tuota funktiota jostain, Esim: MsgBox(HaeWinampKappale)

laxative [31.01.2005 22:01:46]

#

Varsin näpsäkkä. :) Kiitos tosi paljon.
Tosin ihmetyttää, että miten tuon biisien lukumäärän ( numeron tuosta alusta ) saisi pois ja sen tilalle vaikka simppeli "np: "

esakom [31.01.2005 22:06:53]

#

Dim strKappale As String
strKappale = "np: " & Mid$(HaeWinampKappale, 3)
MsgBox strKappale

tuomas [31.01.2005 22:06:57]

#

Avainsana on funktio nimeltä LEFT.

laxative [31.01.2005 22:11:43]

#

Kyseinen strKappale heittää msgboxiin tyhjää.

esakom [31.01.2005 22:15:40]

#

Miten niin?

laxative [31.01.2005 22:17:28]

#

Käsitykseni mukaan tuo koodi nyt laitetaan näin, eikö?

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Const lpClassName = "Winamp v1.x"
Private Const strTtlEnd = " - Winamp"

Private Function HaeWinampKappale() As String
    Dim hwnd As Long
    hwnd = FindWindow(lpClassName, vbNullString)    'etsitään winamp

    Dim lpText As String * 100

    Dim strKappale As String

    If hwnd = 0 Then    'ei löytynyt
        HaeWinampKappale = "Ei kappaletta"
        Exit Function
    End If

    Dim intLength As Integer
    intLength = GetWindowText(hwnd, lpText, Len(lpText))

    If (intLength <= 0) Or (intLength > Len(lpText)) Then   'ei onnistunut
         HaeWinampKappale = "Tuntematon"
         Exit Function
    End If

    Dim strTitle As String  'oletetaan että onnistui
    strTitle = Mid$(lpText, 1, intLength)



    'otetaan vielä mahdollisesti ylimääräinen Winamp teksti lopusta pois
    Dim winampViiva As Integer
    winampViiva = InStr(1, strTitle, strTtlEnd, vbTextCompare)
    If winampViiva > 1 Then
        strTitle = Left$(strTitle, winampViiva)
    End If

    HaeWinampKappale = Trim$(strTitle)

    strKappale = "np: " & Mid$(HaeWinampKappale, 3)


End Function

Korjaa, jos olen väärässä.

esakom [31.01.2005 22:23:48]

#

älä lisää tuota riviä

strKappale = "np: " & Mid$(HaeWinampKappale, 3)

tuohon vaan jonnekin HaeWinampKappale-kutsun jälkeen. Tai jos sen tuohon haluat laittaa, korvaa viimeiset kaksi riviä (ennen end function-loppua):

strTitle = "np: " & Mid$(Trim$(strTitle), 3)
HaeWinampKappale = Trim$(strTitle)

laxative [31.01.2005 22:29:08]

#

Jonkun ihme numerohäkellyksen se silti vetää siihen np: ja biisin nimen väliin...

esakom [31.01.2005 22:30:28]

#

jaa ehkä kappalenumero onkin suurempi kuin yhdeksän, täytyy siinä tapauksessa hieman muokata koodia... kokeilepa vaihtaa kaksi riviä viimeisen end iffin ja end function välilä seuraavilla kolmella rivillä:

strTitle = Trim$(strTitle)
    strTitle = "np: " & Mid$(strTitle, InStr(1, strTitle, ".", vbTextCompare) + 1)
    HaeWinampKappale = Trim$(strTitle)

Metabolix [31.01.2005 22:36:30]

#

strTitle = "np: " & Mid$(Trim$(strTitle), InStr(Trim$(strTitle), " "))
Toimisikohan?

laxative [31.01.2005 22:47:26]

#

Ei kumpikaan.

esakom [31.01.2005 22:53:54]

#

lisääpä tuon

If winampViiva > 1 Then
        strTitle = Left$(strTitle, winampViiva)
    End If

jälkeen MsgBox(strTitle) ja kerro mitä se antaa.

laxative [31.01.2005 23:43:13]

#

Heei .. Sain kikkailtua sen toimimaan. Piruvie. :) .. Kiitoksia. ( Oli välissä yksi rivi liikaa )

Oisko mahdollista laittaa tuon timerin kirjoittamaan seuraavaan tarkennettuun kohteeseen? .. Eli kun timeri hakee tekstin floodbar.text :stä, niin se jää odottamaan seuraavaa hiirenpainallusta, josta se sitten tunnistaa kirjoittaa sen floodbarissa olevan tekstin? :)

Blaze [01.02.2005 09:18:00]

#

Toki on, esimerkiksi laitat sen samaisen timerin kutsumaan millisekunnin välein GetAsyncKeyStatea (joka siis nimestään huolimatta osaa haistella myös hiiren klikkaukset) parametrilla VK_LBUTTON, jonka arvo näyttäisi olevan 1, ja kun klikkaus tunnistetaan, teet, mitä pitää tehdä ja laitat timerin pois päältä.

laxative [01.02.2005 09:38:18]

#

Tuntuu vähän siltä, ettei tää koodaaminen ole mun ala, ku pitää joka kohdassa kysyä, et miten helkkarissa tämä nyt sitten toteutetaan..

hohoo [02.02.2005 17:30:47]

#

Tuon odotusjutun voi varmaan tehdä myös näin:

Option Explicit

'koneen käynnissäoloaika
Private Declare Function GetTickCount Lib "kernel32" () As Long

'ZZZZZZZzzzzzzzzzzzzzzzz....
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub Wait(millisekunnit As Long)
Dim LoppuAika As Long

LoppuAika = GetTickCount + millisekunnit
Do Until GetTickCount >= LoppuAika
Sleep (1)   'vähentää tehon kulutusta, nuQ yksi millisekunti
DoEvents    'vastaa winukan komentoihin tai jotain sinne päin
Loop

End Sub

Latska [02.02.2005 17:38:01]

#

laxative kirjoitti:

Tuntuu vähän siltä, ettei tää koodaaminen ole mun ala, ku pitää joka kohdassa kysyä, et miten helkkarissa tämä nyt sitten toteutetaan..

Noin minäkin ajattelin aluksi. Lähetin QB/VB -alueelle useita aiheita koko ajan. On vähän rauhoittunut nykyään taidot ovat ilmeisesti karttuneet.

Juice [02.02.2005 18:51:08]

#

Latska kirjoitti:

Noin minäkin ajattelin aluksi. Lähetin QB/VB -alueelle useita aiheita koko ajan. On vähän rauhoittunut nykyään taidot ovat ilmeisesti karttuneet.

Aluksi ei meinaa ajatella omilla aivoillaan. Lisäksi pitkän puurtamisen jälkeen saavutetut ratkaisut ovat toivotonta purkkaa(ei funktioista kuultukaan). Sitten sen yhtäkkiä käsittää. Kompaktin koodaamisen.

gceppoo [02.02.2005 19:37:52]

#

laxative kirjoitti:

Hiphei. Toimimaan rupes. Ei ihan se mitä hain ( painallus ja teksti ilmestyy ), mutta kyllä sitä jaksaa itse aktivoida sen ruudun mihin tuo teksti kirjoitetaan.

Mikäli oikein ymmärsin (en jaksanut lukea kaikkia aiempia), haluaisit aktivoida jonkin käynnissä olevan sovelluksen, ikkunan ja lähettää siihen tekstiä?
No, aktivointihan onnistuu helposti:
AppActivate ("Title")
jossa tuon Titlen tilalle kirjoitetaan se mitä ko. ohjelman yläpalkissa lukee, olkoon se sitten vaikka Notepad jossa ei nimettyä tiedostoa:
AppActivate ("Nimetön - Muistio")

mutta tuon aktivoinnin jälkeen pieni viive, ennenkuin siihen lähettää SendKeys -komennolla jotain.

laxative [03.02.2005 22:46:45]

#

Nonnih.. Sain kuin sainkin tämän toteutettua. Tein sitten "globaalin hotkeyn" sille, enkä laittanut sitä commandbuttoniin. Sillai sen sai toimimaan helpoiten.

Private Sub LahetaBiisi_Timer()
If GetAsyncKeyState(vbKeyF6) <> 0 Then
SendKeys (VasenKoriste.Text & " " & (HaeWinampKappale) & " " & OikeeKoriste.Text & "~")
End If
End Sub

Alan pikkuhiljaa päästä vähän jujulle tästä ohjelmoinnista. :)

Pari juttua tosin oisi kiva lisätä.

Eninnäkin, joku nappi, joka tallentaa VasenKoriste.Text:n ja OikeeKoriste.Text:n tekstitiedostoon ja seuraavalla latauskerralla lataisi ne sieltä noihin Textboxeihin ( Koristeet ).

Toiseksi. Onko windows media playeriin samanlaista np scriptaa kuin winampiin?

esakom [03.02.2005 23:31:24]

#

Ei taida microsoftin soittimesta ihan yhtä helposti kappaletiedon luku onnistua, mutta osoitteessa http://weblogs.asp.net/cfrazier/archive/2004/09/23/233503.aspx on joku C# esimerkki, vaatii sen powertoy paketin (toiminee 9 ja 10 versioissa) Ehkä vb samplekin jostain löytyis... Jos joku keksii miten saa luettua ilman lisäpalikoita niin on jo aika guru...

laxative [04.02.2005 15:35:55]

#

Voi piru. Emmä mitään tiedä C#:stä. Millä sitä ees väsätään jne? ..

Kuitenkin. Ei sillä niin väliä ole, jos jonku 2mb pluginin tarvitsee imuttaa, kunhan homma toimii. Helpostihan tuon visual basic 6:n saisi lukemaan tuon windows media playerin captionin ja kirjottamaan sen, vaiko eikö? :)

esakom [04.02.2005 16:26:26]

#

Taitaa riippua media playerin versioista missä mitäkin, lukee, se kun on matkan varrella vaihdellut. Mulla on uusin kymppiversio ja siitä en kyllä kirveelläkään saanut mistään captionista luettua. Mäpä katon jos saisin vb-samplen tosta plugin-esimerkistä...

laxative [04.02.2005 16:27:33]

#

esakom kirjoitti:

Taitaa riippua media playerin versioista missä mitäkin, lukee, se kun on matkan varrella vaihdellut. Mulla on uusin kymppiversio ja siitä en kyllä kirveelläkään saanut mistään captionista luettua. Mäpä katon jos saisin vb-samplen tosta plugin-esimerkistä...

Ok. Jäänpä odottelemaan.

esakom [04.02.2005 16:30:39]

#

Onhan sulla xp, tämä ei taida toimia vanhemmissa käyttiksissä? Ja tää toimii sitten vain soittimen ysi ja kymppiversioissa.

Lataa Blogging Plug-in osoitteesta: http://www.microsoft.com/windowsxp/downloads/powertoys/wm_create.mspx

Sun pitää käynnistää media player uudestaan ton asennuksen jälkeen (tai sulje se ennen asennusta)

Sitten riittääkin että käyt lukemassa tiedot rekisteristä paikasta: HKEY_CURRENT_USER, "Software\\Microsoft\\MediaPlayer\\CurrentMetadata"

Rekisterin lukuesimerkin otin osoitteesta: http://www.devx.com/vb2themax/Tip/19134

Joten koodi voi olla seuraavan tapainen:

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
    Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
    ByVal lpReserved As Long, lpType As Long, lpData As Any, _
    lpcbData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
    Any, source As Any, ByVal numBytes As Long)

Const KEY_READ = &H20019
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const ERROR_MORE_DATA = 234

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006

' Read a Registry value
'
' Use KeyName = "" for the default value
' If the value isn't there, it returns the DefaultValue
' argument, or Empty if the argument has been omitted
'
' Supports DWORD, REG_SZ, REG_EXPAND_SZ, REG_BINARY and REG_MULTI_SZ
' REG_MULTI_SZ values are returned as a null-delimited stream of strings
' (VB6 users can use SPlit to convert to an array of string)

Function GetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
    ByVal ValueName As String, Optional DefaultValue As Variant) As Variant
    Dim handle As Long
    Dim resLong As Long
    Dim resString As String
    Dim resBinary() As Byte
    Dim length As Long
    Dim retVal As Long
    Dim valueType As Long

    ' Prepare the default result
    GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue)

    ' Open the key, exit if not found.
    If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
        Exit Function
    End If

    ' prepare a 1K receiving resBinary
    length = 1024
    ReDim resBinary(0 To length - 1) As Byte

    ' read the registry key
    retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
        length)
    ' if resBinary was too small, try again
    If retVal = ERROR_MORE_DATA Then
        ' enlarge the resBinary, and read the value again
        ReDim resBinary(0 To length - 1) As Byte
        retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
            length)
    End If

    ' return a value corresponding to the value type
    Select Case valueType
        Case REG_DWORD
            CopyMemory resLong, resBinary(0), 4
            GetRegistryValue = resLong
        Case REG_SZ, REG_EXPAND_SZ
            ' copy everything but the trailing null char
            resString = Space$(length - 1)
            CopyMemory ByVal resString, resBinary(0), length - 1
            GetRegistryValue = resString
        Case REG_BINARY
            ' resize the result resBinary
            If length <> UBound(resBinary) + 1 Then
                ReDim Preserve resBinary(0 To length - 1) As Byte
            End If
            GetRegistryValue = resBinary()
        Case REG_MULTI_SZ
            ' copy everything but the 2 trailing null chars
            resString = Space$(length - 2)
            CopyMemory ByVal resString, resBinary(0), length - 2
            GetRegistryValue = resString
        Case Else
            RegCloseKey handle
            Err.Raise 1001, , "Unsupported value type"
    End Select

    ' close the registry key
    RegCloseKey handle
End Function



Private Sub Command1_Click()
    Dim Title As String
    Dim Author As String

    Title = GetRegistryValue(HKEY_CURRENT_USER, "Software\\Microsoft\\MediaPlayer\\CurrentMetadata", "Title")
    Author = GetRegistryValue(HKEY_CURRENT_USER, "Software\\Microsoft\\MediaPlayer\\CurrentMetadata", "Author")
    MsgBox Author & " - " & Title


End Sub

Toitsu [05.02.2005 21:47:32]

#

Voisko joku vääntää aloittelijalle mallin tuosta koodista, että miten luetaan ""HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\CurrentVersion\Uninstall"" kohdasta kaikki asennetut ohjelmat? :) Ei liene iso muutos?

esakom [05.02.2005 23:00:04]

#

Osoitteesta http://vbnet.mvps.org/index.html?code/reg/reguninstall.htm löytyy valmis esimerkki. Ja se listview löytyy common contols:seista.

Toitsu [05.02.2005 23:09:36]

#

Muuten kiva, mutta on vb.net versio. Tarttis vb6 version...

esakom [05.02.2005 23:30:26]

#

kyllä se on vb6 versio, kokeile vaikka! toi vbnet on vain ton mestan nimi...

Toitsu [06.02.2005 17:19:53]

#

Compile error: User-defined type not defined?

Joko mun tyhmyyttä tai siinä on joku bugi?

esakom [06.02.2005 17:31:37]

#

no bugia siinä ei ole.
miltä riviltä se herjaa? lisäsithän kontrollit formille?

"Add a single command button (Command1), text box (Text1), and a listview (Listview1) to a form along with the following code:"

kokeile vaikka ensin uuteen tyhjään projektiin, jossa ei ole aikaisempaa koodia häiritsemässä.

Toitsu [06.02.2005 17:34:24]

#

Jep, kontrollit heitin formille. Rivi on:

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

esakom [06.02.2005 17:39:56]

#

lisäsithän varmasti oikean listview-kontrollin (siis sulla pitäis olla tuo common contols-ocx lisättynä (valikosta project-components- ja listasta Microsoft Windows Common Controls 6.0, eli mscomctl.ocx)

Toitsu [06.02.2005 17:43:24]

#

No niin, eli mun tyhmyys... :D Olin lisännyt version 5.0....

Suur kiitos! Sitten vähän modaileen ja miettiin miten toi toimii, jos vaikka oppis jotain!

esakom [06.02.2005 17:45:54]

#

onnea matkaan!


Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta