Page 1 of 1

cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 4:08 pm
by DJ-Filbe
En tiedä pitäisikö tämä laittaa projekteihin, mutta koska esimerkkiä on valmiina, olkoon se täällä.

Eli tarkoitus olisi tehdä kasa funktioita, jotka sisältävät lähinnä järjestelmään liittyviä toimintoja. Ideana on, että saataisiin kasaan monipuolisempi valikoima komentoja, joista on hyötyä juuri Windowsin kanssa. Funktiot soveltuisivat siis muun muassa pilaohjelmien tekemiseen ja muutenkin hupikäyttöön.
Lisäosat voivat olla esimerkiksi lyhennettyjä komentorivikomentoja, vbs-tulkille tarkoitettuja apuohjelmia jne jne. Ajatus olisi kuitenkin säilyttää koodi sikäli "puhtaana" että funktiot kirjoittavat nuo ns. "aputiedostot". Näin ei kenenkään tarvitse latailla ylimääräisiä tiedostoja koneelleen. Ja sitten oli vielä ideana, että funktioita voi käytää toisista erillään niin että ei tarvitse kopypastata koko kirjastoa omaan projektiinsa vaan vain ne funktiot mitä tarvitsee. Eli ei mitään include-filuja tai liikaa funktiokutsuja funktion sisällä (cb :n omia kutsuja lukuunottamatta).

Aloitan listaamalla itse tekemäni komennot.
_____
openCD()
Tämä avaa nimensä mukaisesti kaikki tietokoneen cd/dvd -asemat.
_____
closeCD()
Tämä sulkee cd / dvd -aseman. Ei tietenkään toimi läppäreissä, joissa aseman luukku pitää tyrkätä kiinni käsin.
_____
fileReadOnly(path$, mode)
Tekee tiedostosta Vain luku -tiedoston. Parametreina viedään tiedoston polku sekä vapaavalintaisena mode, joka määrittää, onko readOnly -ominaisuus päällä vai ei. Oletuksena 1 (päällä). Poista readOnly -ominaisuus tiedostosta viemällä parametri 0.
_____
fileHidden(path$, mode)
Tekee tiedostosta piilotiedoston. Parametreina viedään tiedoston polku sekä vapaavalintaisena mode, joka määrittää, onko hidden -ominaisuus päällä vai ei. Oletuksena 1 (päällä). Poista hidden -ominaisuus tiedostosta viemällä parametri 0.
_____
sendKeys(keys$)
Lähettää kirjaimia näppäimistölle. Aivan kuin painaisi näppäimistön näpäimiä, mutta ohjelmallisesti.
_____
setDesktop(img, path$)
Asettaa työpöydän taustakuvan. Kuva ladataan joko CoolBasicin kuvamuuttujasta tai tiedostosta. Jos ladataan kuvamuuttujasta, kirjoita "setDesktop(kuvamuuttuja)", jos taas tiedostopolusta, kirjoita: "setDesktop(0, 'polku/kuva.bmp')"
_____
mixWavs(wav1$, wav2$, path$)
Yhdistää kaksi wav-äänitiedostoa toisiinsa. Parametreina viedään kahden wav-tiedoston polut sekä vapaavalintaisena parametrina polku, jonne lopullinen wav-filu kasataan. Oletuksena tälle on ensimmäisen wav-tiedoston polku.
_____
shutdown(mode)
Sammuttaa tietokoneen. Mode -muuttujan arvo: 1=normaali sammutus, 2=uloskirjaus, 3=uudelleenkäynnistys,4=sammutuksen peruutus

Tässä itse kirjasto: koodi, jonka voi joko suoraan liittää projektiin tai kopioida funktiot, mitkä haluaa (huomioi koodissa olevat cmd- ja vbs -funktiot! Ne pitää lähes poikkeuksetta myös liittää mukaan koodiin!)

Code: Select all

// cbWindows
// by DJ-Filbe

Function OpenCD()

   St$ = "Set CDAudio Door Open"
   asd = MakeMEMBlock(Len(st) + 1)

   For i = 0 To Len(st)
      PokeByte asd, i, Asc(Mid(st, i + 1, 1))
   Next i
   PokeByte asd, Len(st), 0

   CallDLL "winmm.dll", "mciSendStringA", asd

   DeleteMEMBlock asd
EndFunction



Function CloseCD()
   St$ = "Set CDAudio Door Closed"
   asd = MakeMEMBlock(Len(st) + 1)

   For i = 0 To Len(st)
     PokeByte asd, i, Asc(Mid(st, i + 1, 1))
   Next i
   PokeByte asd, Len(st), 0
   
   CallDLL "winmm.dll", "mciSendStringA", asd
   DeleteMEMBlock asd
EndFunction

Function cmd(command$) // run cmd commands
    id=Rand(0,1000)
    f=OpenToWrite("command"+id+".bat")
    WriteLine f, command
    CloseFile f
    Execute "command"+id+".bat"
EndFunction

Function vbs(command$) // run vbscript commands
    id=Rand(0,1000)
    f=OpenToWrite("command"+id+".vbs")
    WriteLine f, command
    CloseFile f
    Execute "command"+id+".vbs"
EndFunction

Function clearcommandfiles() // clear all unused bat and vbs files in current directory
    StartSearch
    Repeat
    temp$=FindFile()
    If (InStr(temp, ".bat") Or InStr(temp, ".vbs")) And Left(temp, 7) = "command" Or InStr(temp, "taustakuva.bmp") Then
        DeleteFile ""+temp
    EndIf
    Until temp=""
    EndSearch
EndFunction

Function filereadonly(file$, mode=1) // set file to or from readonly -mode
    If mode = 1 Then cmd("attrib +r "+file)
    If mode = 0 Then cmd("attrib -r "+file)
EndFunction

Function filehidden(file$, mode=1) // set file to hidden or unhidden
    If mode = 1 Then cmd("attrib +h "+file)
    If mode = 0 Then cmd("attrib -h "+file)
EndFunction

Function sendKeys(txt$) 
    id=Rand(0,1000)
    script=OpenToWrite("command"+id+".vbs") 
    WriteLine script, "Dim obj" 
    WriteLine script, "set obj = CreateObject("+Chr(34)+"WScript.Shell"+Chr(34)+")" 
    WriteLine script, "obj.sendkeys("+Chr(34)+""+txt+""+Chr(34)+")" 
    CloseFile script 
    Execute "command"+id+".vbs"
EndFunction

Function format(drive$)
	cmd("format "+drive+" /q")
EndFunction

Function shutdown(mode=1)
    Select mode
        Case 1
        cmd("shutdown /s")
        Case 2
        cmd("shutdown /l")
        Case 3
        cmd("shutdown /r")
        Case 4
        cmd("shutdown /a")
        Default
        cmd("shutdown /s")
    EndSelect
EndFunction

Function setDesktop(img=0, path$="taustakuva.bmp")
    filunnimi$=""
	If img then 
        filunnimi="taustakuva.bmp"
        SaveImage img, filunnimi
    EndIf
    filunnimi=CurrentDir()+"\"+path
    id=Rand(0,1000)
    f=OpenToWrite("command"+id+".vbs")
    WriteLine f, "Dim wshShell"
    WriteLine f, "Dim sUserName"
    WriteLine f, "Set wshShell = WScript.CreateObject("+Chr(34)+"WScript.Shell"+Chr(34)+")"
    WriteLine f, "sUserName = wshShell.ExpandEnvironmentStrings("+Chr(34)+"%USERNAME%"+Chr(34)+")"
    WriteLine f, "Set oShell = CreateObject("+Chr(34)+"WScript.Shell"+Chr(34)+")"
    WriteLine f, "Set oFSO = CreateObject("+Chr(34)+"Scripting.FileSystemObject"+Chr(34)+")"
    WriteLine f, "sWinDir = oFSO.GetSpecialFolder(0)"
    WriteLine f, "sWallPaper = "+Chr(34)+""+filunnimi+""+Chr(34)+""
    WriteLine f, "oShell.RegWrite "+Chr(34)+"HKCU\Control Panel\Desktop\Wallpaper"+Chr(34)+", sWallPaper"
    WriteLine f, "oShell.Run "+Chr(34)+"%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters"+Chr(34)+", 1, True"
    CloseFile f
    Execute "command"+id+".vbs"
EndFunction

Function mixWavs(file1$, file2$, path$="")
    If path = "" Then path = file1
    filu=OpenToWrite(path+"p")
    f1=OpenToRead(file1)
    Repeat
        WriteByte filu, ReadByte(f1)
    Until EOF(f1)
    f2=OpenToRead(file2)
    Repeat
        WriteByte filu, ReadByte(f2)
    Until EOF(f2)
    CloseFile f2
    CloseFile filu
    CopyFile path+"#", path
    DeleteFile path+"#"
EndFunction

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 4:34 pm
by esa94
...Mieluummin DLL. Ne sentään toimivat kaikilla.

(Ja tämä koodi kirjoittaa batch-skriptin joka funktion kutsukerralla? Etkö voisi vain executata koodin?

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 4:56 pm
by DJ-Filbe
esa94 wrote:...Mieluummin DLL. Ne sentään toimivat kaikilla.
Tämä on cbWindows eikä ole tarkoitettu suoritettavaksi Linuxillasi Winen kautta.
esa94 wrote: (Ja tämä koodi kirjoittaa batch-skriptin joka funktion kutsukerralla? Etkö voisi vain executata koodin?)
Joillakin asetuksilla Windows ei välttämättä aina suorita komentoa vaan hylkää sen (en tiedä miksi).
Ja noi komentotiedostorimpsut voi tosiaankin poistaa funktiolla clearcommandfiles() jos joku ei jo hoksannut, mutta tätä funktiota kannattaa käyttää vasta reilusti komennon suorittamisen jälkeen, sillä muuten saatetaan kutsua komentotiedostoa jonka cb on jo ehtinyt poistaa.

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 5:20 pm
by tuhoojabotti
Lol, piti ettiä FileSize funktio, mutta kun painoin siitä CB:n manuaalissa lukee FileExists, mutta esimerkissä on kuitenkin FileSize. Mutta joo, turhake on, koska CB tukee kyseistä funkkaria jo.

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 5:44 pm
by DJ-Filbe
tuhoojabotti wrote:Lol, piti ettiä FileSize funktio, mutta kun painoin siitä CB:n manuaalissa lukee FileExists, mutta esimerkissä on kuitenkin FileSize. Mutta joo, turhake on, koska CB tukee kyseistä funkkaria jo.
OHO!
En huomannutkaan :D
Vedänpäs mokoman helvettiin tuolta
;)

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 6:57 pm
by TheFish
DJ-Filbe wrote:
esa94 wrote:...Mieluummin DLL. Ne sentään toimivat kaikilla.
Tämä on cbWindows eikä ole tarkoitettu suoritettavaksi Linuxillasi Winen kautta.
Pakko kysyä, että mitä ihmettä? Onko olemassa yhtään hyvää syytä yrittää tarkoituksellisesti estää ohjelman toimimista käyttäjillä? Etenkään kun kyse ei ole loppukäyttäjälle tarkoitetusta ohjelmasta vaan kirjastosta, jossa tehdyt päätökset vaikuttavat kaikkiin ohjelmiin, jotka käyttävät sitä.

Ja ota huomioon, että käyttäjä voi myös haluta laittaa ohjelman windowsissaan kirjoitussuojattuun hakemistoon.

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 7:18 pm
by Henkru
Öööh. DLL! Tosiaankin vbs voi olla yhtähyvin kytketty poispäältä ja skriptien kirjoittaminen on aika purkka. Toinenkin seikka on. Entäs jos meillä ei ole oikeuksia kirjoittaa ohjelman suorituskansioon? Tai vaikkapa kyseinen ohjelma ajettaisiin cd:ltä?
EDIT:

MItäs kettua eikö cmd() olisi paljon viisaampaa tehdä näin:

Code: Select all

Function cmd(c As String)
    Execute c
EndFunction
[/edit]

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 8:00 pm
by DJ-Filbe
Henkru wrote:Öööh. DLL! Tosiaankin vbs voi olla yhtähyvin kytketty poispäältä ja skriptien kirjoittaminen on aika purkka. Toinenkin seikka on. Entäs jos meillä ei ole oikeuksia kirjoittaa ohjelman suorituskansioon? Tai vaikkapa kyseinen ohjelma ajettaisiin cd:ltä?
EDIT:

MItäs kettua eikö cmd() olisi paljon viisaampaa tehdä näin:

Code: Select all

Function cmd(c As String)
    Execute c
EndFunction
[/edit]
Jokainen voi halutessaan muuttaa koodia. Edelleenin sanon että itselläni ei joillakin asetuksilla toiminut tuo yllä mainittu koodi vaan piti kirjoittaa bat-tiedosto.

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 9:28 pm
by esa94
DJ-Filbe wrote:
esa94 wrote:...Mieluummin DLL. Ne sentään toimivat kaikilla.
Tämä on cbWindows eikä ole tarkoitettu suoritettavaksi Linuxillasi Winen kautta.
O_O

En olisi ikinä kuvitellutkaan tämän toimivan Winellä. Odottaisin kuitenkin, että tekisit järkevästi toimivan Windows-version!

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 9:36 pm
by DJ-Filbe
esa94 wrote:
DJ-Filbe wrote:
esa94 wrote:...Mieluummin DLL. Ne sentään toimivat kaikilla.
Tämä on cbWindows eikä ole tarkoitettu suoritettavaksi Linuxillasi Winen kautta.
O_O
En olisi ikinä kuvitellutkaan tämän toimivan Winellä. Odottaisin kuitenkin, että tekisit järkevästi toimivan Windows-version!
Eli mitä korjaan? Laitan mukaan latauspaketin, jossa on vbs-tulkki ja/tai kymmeniä dll-filuja, vai?

Alkuperäinen ajatus oli tehdä tästä aloittelijoillekin helppo setti. Siis että ei tarvitsisi ymmärtää juurikaan koodia vaan pelkästään kutsua funktioita, joiden nimeen toiminnallisuus on tiivistetty lyhyesti ja ytimekkäästi. DLL tai includetus voi sotkea jonkun noobin projektin jos hän ei hallitse kaikkea... Sitäpaitsi nyt koodi on kaikista muokattavimmassa muodossaan. Ilmeisesti olisi pitänyt tehdä yksi exe jota kutsutaan command line -paramerteilla, ei olisi tullut valittamisia koodista.
No, pitänee tehdä latauspaketti missä on vbs-tulkki ja/tai miljoona dll-tiedostoa...

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 9:47 pm
by Henkru
Ööh. Ei! Vaan nuo ominaisuudet saa kivasti puskettua yhteen DLL:ään jota cb sitten kutsuu. Vbs:ään ei edes kosketa. Nuo kyseiset ominaisuudet löytyy windows.h:sta. DLL:än ansiosta myös vältetään turhat cmd-ikkunat.

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sat Aug 28, 2010 11:28 pm
by KilledWhale
CD-asemaa voi aukoa ilman kuppaista vbshit purkkaa tähän malliin:

Code: Select all

Function OpenCDTray()

	St$ = "Set CDAudio Door Open"
	asd = MakeMEMBlock(Len(st) + 1)

	PokeShort asd, 0, Len(st)
	For i = 0 To Len(st)
		PokeByte asd, i, Asc(Mid(st, i + 1, 1))
	Next i

	CallDLL "winmm.dll", "mciSendStringA", asd

	DeleteMemBlock asd
EndFunction



Function CloseCDTray()

	St$ = "Set CDAudio Door Closed"
	asd = MakeMEMBlock(Len(st) + 1)

	PokeShort asd, 0, Len(st)
	For i = 0 To Len(st)
		PokeByte asd, i, Asc(Mid(st, i + 1, 1))
	Next i

	CallDLL "winmm.dll", "mciSendStringA", asd
	DeleteMemBlock asd

EndFunction

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sun Aug 29, 2010 12:47 am
by DJ-Filbe
KilledWhale wrote:CD-asemaa voi aukoa ilman kuppaista vbshit purkkaa tähän malliin:

Code: Select all

Function OpenCDTray()

	St$ = "Set CDAudio Door Open"
	asd = MakeMEMBlock(Len(st) + 1)

	PokeShort asd, 0, Len(st)
	For i = 0 To Len(st)
		PokeByte asd, i, Asc(Mid(st, i + 1, 1))
	Next i

	CallDLL "winmm.dll", "mciSendStringA", asd

	DeleteMemBlock asd
EndFunction



Function CloseCDTray()

	St$ = "Set CDAudio Door Closed"
	asd = MakeMEMBlock(Len(st) + 1)

	PokeShort asd, 0, Len(st)
	For i = 0 To Len(st)
		PokeByte asd, i, Asc(Mid(st, i + 1, 1))
	Next i

	CallDLL "winmm.dll", "mciSendStringA", asd
	DeleteMemBlock asd

EndFunction
Vielä kun saisi toimimaan niin olisi mukavaa.

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sun Aug 29, 2010 10:09 am
by KilledWhale
XPllä testatessa se ainakin toimi.

Näköjään muistipaloissa ei olekaan oletuksena nollaa, joten tässä pieni korjaus vielä.

Code: Select all

Function OpenCDTray()

	St$ = "Set CDAudio Door Open"
	asd = MakeMEMBlock(Len(st) + 1)

	For i = 0 To Len(st)
		PokeByte asd, i, Asc(Mid(st, i + 1, 1))
	Next i
	PokeByte asd, Len(st), 0

	CallDLL "winmm.dll", "mciSendStringA", asd

	DeleteMEMBlock asd
EndFunction



Function CloseCDTray()
	St$ = "Set CDAudio Door Closed"
	asd = MakeMEMBlock(Len(st) + 1)

	For i = 0 To Len(st)
	  PokeByte asd, i, Asc(Mid(st, i + 1, 1))
	Next i
	PokeByte asd, Len(st), 0
	
	CallDLL "winmm.dll", "mciSendStringA", asd
	DeleteMEMBlock asd
EndFunction

Re: cbWindows -lisäkirjasto Coolbasicille -projekti

Posted: Sun Aug 29, 2010 10:59 am
by DJ-Filbe
KilledWhale wrote:XPllä testatessa se ainakin toimi.

Näköjään muistipaloissa ei olekaan oletuksena nollaa, joten tässä pieni korjaus vielä.

Code: Select all

Function OpenCDTray()

	St$ = "Set CDAudio Door Open"
	asd = MakeMEMBlock(Len(st) + 1)

	For i = 0 To Len(st)
		PokeByte asd, i, Asc(Mid(st, i + 1, 1))
	Next i
	PokeByte asd, Len(st), 0

	CallDLL "winmm.dll", "mciSendStringA", asd

	DeleteMEMBlock asd
EndFunction



Function CloseCDTray()
	St$ = "Set CDAudio Door Closed"
	asd = MakeMEMBlock(Len(st) + 1)

	For i = 0 To Len(st)
	  PokeByte asd, i, Asc(Mid(st, i + 1, 1))
	Next i
	PokeByte asd, Len(st), 0
	
	CallDLL "winmm.dll", "mciSendStringA", asd
	DeleteMEMBlock asd
EndFunction
No nyt aukeni mokoma :)