Monday, July 3, 2017

vbs TUTO txt

set shellobj = CreateObject("WScript.Shell")
shellobj.run "cmd"
wscript.sleep 100
shellobj.sendkeys "shutdown"
wscript.sleep 20
Shellobj.sendkeys " /s"
wscript.sleep 20
shellobj.sendkeys [ENTER]

------------------


x=msgbox("Would you like to open the Windows folder?" ,4, "Question:")

If x = vbNo Then Wscript.Quit(0)

If x = VbYes Then

Set WshShell = CreateObject("WScript.Shell")

X = WshShell.run("cmd /c explorer.exe ""C:\Windows""",0, true)

End If

------------------------

strMB = inputbox("Please enter your message here:")

Set WshShell = CreateObject("WScript.Shell")

WshShell.run "cmd /c @echo msgbox " & """" & strMB & """" & ",4096,""VBS2CMD2VBS:"">C:\Message.vbs",0, true

WshShell.run "C:\windows\system32\wscript.exe C:\Message.vbs",0, false

Wscript.Quit(0)


-----------------------------

strMB = inputbox("Please enter your message here:")

msgbox strMB, 4096, "Message"

------------------------


(A)

x=msgbox("Would you like to continue?" ,4, "Question:")

If x = vbNo Then MsgBox "You selected 'No'", 4096, "No:"

If x = VbYes Then MsgBox "You selected 'Yes'", 4096, "Yes:"

(B)

x=msgbox("Would you like to continue?" ,4, "Question:")

If x = vbNo Then

MsgBox "You selected 'No'", 4096, "No:"

Wscript.Quit(0)

End If

If x = VbYes Then

MsgBox "You selected 'Yes'", 4096, "Yes:"

Wscript.Quit(0)

End If

(C)

x=msgbox("Would you like to continue?" ,4, "Question:")

If x = vbNo Then

MsgBox "You selected 'No'", 4096, "No:"

Else

MsgBox "You selected 'Yes'", 4096, "Yes:"

End If

Wscript.Quit(0)


-------------------------


x=msgbox("Would you like to continue?" & VbCrLf & "If you select No, you will see NO" & VbCrLf & VbCrLf & "If you select Yes, you will see YES",4, "Question:")

If x = vbNo Then

MsgBox "NO", 4096, "No:"

Else

MsgBox "YES", 4096, "Yes:"

End If

--------------------------------------


Set WshShell = CreateObject("WScript.Shell")

x = WshShell.Popup("Would you like to continue?",5,"Title:",4)

If x = vbNo Then Wscript.Quit(0)

If x = VbYes Then

'Your script goes here

msgbox "you selected YES!", 4096, "Yes"

End If


--------------------------------------------



'************************************************
' File:    Input.vbs (WSH sample in VBScript) 
' Author:  (c) G. Born
'
' Retrieving user input in VBScript
'************************************************
Option Explicit

Dim Message, result
Dim Title, Text1, Text2

' Define dialog box variables.
Message = "Please enter a path"           
Title = "WSH sample user input - by G. Born"
Text1 = "User input canceled"
Text2 = "You entered:" & vbCrLf

' Ready to use the InputBox function
' InputBox(prompt, title, default, xpos, ypos)
' prompt:    The text shown in the dialog box
' title:     The title of the dialog box
' default:   Default value shown in the text box
' xpos/ypos: Upper left position of the dialog box 
' If a parameter is omitted, VBScript uses a default value.

result = InputBox(Message, Title, "C:\Windows", 100, 100)

' Evaluate the user input.
If result = "" Then    ' Canceled by the user
    WScript.Echo Text1
Else 
    WScript.Echo Text2 & result
End If

'*** End

'result = InputBox(prompt[, [title], [default], [xpos], [ypos]])
'The InputBox function has the following parameters:
'prompt A required parameter that defines the message shown in the dialog box. In Figure 8-1, this is the string Please Enter A Path.
'title An optional parameter that defines the title bar text for the dialog box.
'default An optional parameter that specifies the default value shown in the text box.
'xpos and ypos Optional parameters that define the position of the upper left corner of the dialog box.
'InputBox("Hello", "Test", , 100, 200)
'If result = "" Then    ' Test for Cancel.
'    WScript.Echo "Canceled"
'Else 
'    WScript.Echo "You entered: " & result
'End If
---------------------------------------

http://wsh2.uw.hu/ch08b.html

http://www.instructables.com/id/How-to-Make-a-message-box-using-VBScript/


---------------------


Set objFSO=CreateObject("Scripting.FileSystemObject")

' How to write file
outFile="c:\test\autorun.inf"
Set objFile = objFSO.CreateTextFile(outFile,True)
objFile.Write "test string" & vbCrLf
objFile.Close

'How to read a file
strFile = "c:\test\file"
Set objFile = objFS.OpenTextFile(strFile)
Do Until objFile.AtEndOfStream
    strLine= objFile.ReadLine
    Wscript.Echo strLine
Loop
objFile.Close

'to get file path without drive letter, assuming drive letters are c:, d:, etc
strFile="c:\test\file"
s = Split(strFile,":")
WScript.Echo s(1)

------------------------------

Option Explicit

Const fsoForReading = 1
Const fsoForWriting = 2

Function LoadStringFromFile(filename)
    Dim fso, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.OpenTextFile(filename, fsoForReading)
    LoadStringFromFile = f.ReadAll
    f.Close
End Function

Sub SaveStringToFile(filename, text)
    Dim fso, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.OpenTextFile(filename, fsoForWriting)
    f.Write text
    f.Close
End Sub

SaveStringToFile "f.txt", "Hello World" & vbCrLf
MsgBox LoadStringFromFile("f.txt")

------------------------------------


'You can create a temp file, then rename it back to original file:

Set objFS = CreateObject("Scripting.FileSystemObject")
strFile = "c:\test\file.txt"
strTemp = "c:\test\temp.txt"
Set objFile = objFS.GetFile(strFile)
Set objOutFile = objFS.CreateTextFile(strTemp,True)
Set ts = objFile.OpenAsTextStream(1,-2)
Do Until ts.AtEndOfStream
    strLine = ts.ReadLine
    ' do something with strLine 
    objOutFile.Write(strLine)
Loop
objOutFile.Close
ts.Close
objFS.DeleteFile(strFile)
objFS.MoveFile strTemp,strFile 


'Usage is almost the same using OpenTextFile:

Set objFS = CreateObject("Scripting.FileSystemObject")
strFile = "c:\test\file.txt"
strTemp = "c:\test\temp.txt"
Set objFile = objFS.OpenTextFile(strFile)
Set objOutFile = objFS.CreateTextFile(strTemp,True)    
Do Until objFile.AtEndOfStream
    strLine = objFile.ReadLine
    ' do something with strLine 
    objOutFile.Write(strLine & "kndfffffff")
Loop
objOutFile.Close
objFile.Close
objFS.DeleteFile(strFile)
objFS.MoveFile strTemp,strFile 


------------------------------

http://stackoverflow.com/questions/1142678/read-and-write-into-a-file-using-vbscript

http://stackoverflow.com/questions/2198810/creating-and-writing-lines-to-a-file


--------------------------------------


The File System Object, generally used by VBScript developers to read and write text files, can read only ASCII or Unicode text files. You cannot use it to read or write UTF-8 encoded text files.

But, if you can use Microsoft ActiveX Data Objects (ADO), you can read UTF-8 encoded text files like this:

Dim objStream, strData
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Open
objStream.LoadFromFile("C:\Users\admin\Desktop\test.txt")
strData = objStream.ReadText()
If you want to write a UTF-8 encode text file, you can do so like this:

Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Open
objStream.WriteText "The data I want in utf-8"
objStream.SaveToFile "C:\Users\admin\Desktop\test.txt", 2


--------------------------------------


http://developer.rhino3d.com/guides/rhinoscript/read_write_utf8/



Volume Delphi SET

var
MixerControl: TMixerControl;
MixerControlDetails: TMixerControlDetails;
MixerControlDetailsSigned: TMixerControlDetailsSigned;
Mixer: THandle;
MixerLine: TMixerLine;
MixerLineControls: TMixerLineControls;
PeakMeter: DWord;
Rslt: DWord;
SourceCount: Cardinal;
WaveOut: DWord;
I: Integer;
X: Integer;
Y: Integer;
begin
Rslt := mixerOpen(@Mixer, 0, 0, 0, 0);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t open mixer (%d)', [Rslt]);
FillChar(MixerLine, SizeOf(MixerLine), 0);
MixerLine.cbStruct := SizeOf(MixerLine);
MixerLine.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Rslt := mixerGetLineInfo(Mixer, @MixerLine, 
MIXER_GETLINEINFOF_COMPONENTTYPE); 
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t find speaker line (%d)', [Rslt]);
SourceCount := MixerLine.cConnections;
WaveOut := $FFFFFFFF;
for I := 0 to SourceCount - 1 do
begin
MixerLine.dwSource := I;
Rslt := mixerGetLineInfo(Mixer, @MixerLine,
MIXER_GETLINEINFOF_SOURCE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t get source line (%d)', [Rslt]);
if MixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT
then
begin
WaveOut := MixerLine.dwLineId;
Break;
end;
end;
if WaveOut = $FFFFFFFF then
raise Exception.Create('Can''t find wave out device');
FillChar(MixerLineControls, SizeOf(MixerLineControls), 0);
with MixerLineControls do
begin
cbStruct := SizeOf(MixerLineControls);
dwLineId := WaveOut;
dwControlType := MIXERCONTROL_CONTROLTYPE_PEAKMETER;
cControls := 1;
cbmxctrl := SizeOf(TMixerControl);
pamxctrl := @MixerControl;
end;
Rslt := mixerGetLineControls(Mixer, @MixerLineControls, 
MIXER_GETLINECONTROLSF_ONEBYTYPE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t find peak meter control (%d)',
[Rslt]);
PeakMeter := MixerControl.dwControlID;

// at this point, I have the meter control ID, so I can
// repeatedly query its value and plot the resulting data
// on a canvas

X := 0;
FillChar(MixerControlDetails, SizeOf(MixerControlDetails), 0);
with MixerControlDetails do
begin
cbStruct := SizeOf(MixerControlDetails);
dwControlId := PeakMeter;
cChannels := 1;
cbDetails := SizeOf(MixerControlDetailsSigned);
paDetails := @MixerControlDetailsSigned;
end;
repeat
Sleep(10);
Rslt := mixerGetControlDetails(Mixer, @MixerControlDetails, 
MIXER_GETCONTROLDETAILSF_VALUE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t get control details (%d)',
[Rslt]);
Application.ProcessMessages;
Inc(X);
Y := 300 - Round(300 * Abs(MixerControlDetailsSigned.lValue) /
32768);
with Canvas do
begin
MoveTo(X, 0);
Pen.Color := clBtnFace;
LineTo(X, 300);
Pen.Color := clWindowText;
LineTo(X, Y);
end;
until X > 500;

// don't forget to close the mixer handle when you're done

Rslt := mixerClose(Mixer);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t close mixer (%d)', [Rslt]);
end;


http://torry.net/pages.php?id=186

http://www.swissdelphicenter.ch/en/showcode.php?id=225

{1.}

uses
  MMSystem;

procedure SetVolume(const volL, volR: Word);
var
  hWO: HWAVEOUT;
  waveF: TWAVEFORMATEX;
  vol: DWORD;
begin
  // init TWAVEFORMATEX
  FillChar(waveF, SizeOf(waveF), 0);
  // open WaveMapper = std output of playsound
  waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);
  vol := volL + volR shl 16;
  // set volume
  waveOutSetVolume(hWO, vol);
  waveOutClose(hWO);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetVolume(14000, 14000);
end;


{************************************************}

{2.}

{by Serhiy Perevoznyk}

uses
  MMSystem;


function GetVolumeControl(aMixer: HMixer; componentType, ctrlType: Longint;
  var mxc: TMixerControl): Boolean;
var
  mxl: TMixerLine;
  mxlc: TMixerLineControls;
  rc: Longint;
begin
  Result := False;
  FillChar(mxl, SizeOf(TMixerLine), 0);
  mxl.cbStruct := SizeOf(TMixerLine);
  mxl.dwComponentType := componentType;
  {Obtain a line corresponding to the component type}
  rc := mixerGetLineInfo(aMixer, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
  if rc = MMSYSERR_NOERROR then
  begin
    with mxlc do
    begin
      cbStruct := SizeOf(TMixerLineControls);
      dwLineID := mxl.dwLineID;
      dwControlType := ctrlType;
      cControls := 1;
      cbmxctrl := SizeOf(TMixerLine);
      pamxctrl := @mxc;
      pamxctrl^.cbStruct := SizeOf(TMixerControl);
    end;
    mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
    rc := mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
    Result := rc = MMSYSERR_NOERROR;
  end;
end;

function SetVolumeControl(aMixer: HMixer; mxc: TMixerControl; volume: Longint): Boolean;
var
  mxcd: TMixerControlDetails;
  vol: TMixerControlDetails_Unsigned;
  rc: MMRESULT;
begin
  FillChar(mxcd, SizeOf(mxcd), 0);
  with mxcd do
  begin
    cbStruct := SizeOf(TMixerControlDetails);
    dwControlID := mxc.dwControlID;
    cbDetails := SizeOf(TMixerControlDetails_Unsigned);
    paDetails := @vol;
    cMultipleItems := 0;
    cChannels := 1;
  end;
  vol.dwValue := volume;
  rc := mixerSetControlDetails(aMixer, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
  Result := rc = MMSYSERR_NOERROR;
end;

function InitMixer: HMixer;
var
  Err: MMRESULT;
begin
  Err := mixerOpen(@Result, 0, 0, 0, 0);
  if Err <> MMSYSERR_NOERROR then
    Result := 0;
end;

// Example:


procedure SetMasterVolumeToZero;
var
  MyMixerHandle: HMixer;
  MyVolCtrl: TMixerControl;
begin
  MyMixerHandle := InitMixer;
  if MyMixerHandle <> 0 then
    try
      FillChar(MyVolCtrl, SizeOf(MyVolCtrl), 0);
      if GetVolumeControl(MyMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
        MIXERCONTROL_CONTROLTYPE_VOLUME, MyVolCtrl) then
      begin
        {The last parameter (0) here is the volume level}
        if SetVolumeControl(MyMixerHandle, MyVolCtrl, 0) then
          ShowMessage('Volume should now be set to zero');
      end;
    finally
      mixerClose(MyMixerHandle);
    end;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
 SetMasterVolumeToZero
end;

vpn smb tunnel ssh

Very Important Data Filter PHP

function data_filter($data)
{
    // remove whitespaces from begining and end
    $data = trim($data);
    
    // apply stripslashes to pevent double escape if magic_quotes_gpc is enabled
    if(get_magic_quotes_gpc())
    {
        $data = stripslashes($data);
    }
    // connection is required before using this function
    $data = mysqli_real_escape_string($conn,$data);
    return $data;
}

t4 commander

Dim shell
Set shell = CreateObject("Shell.Application")

shell.Open "c:\"
shell.Open "d:\"


Dim objShell
   Dim strPath
   Dim strPath2

   Set objShell = CreateObject("Wscript.Shell")
   strPath = objShell.SpecialFolders("Desktop")
   strPath2 = objShell.SpecialFolders("MyDocuments")

   rem wscript.echo strPath

shell.Open strPath
shell.Open strPath2

Wscript.Sleep 1000

rem shell.TileHorizontally

shell.TileVertically

rem shell.ToggleDesktop

rem shell.WindowSwitcher



rem http://ss64.com/vb/special.html

rem      AllUsersDesktop
rem      AllUsersStartMenu
rem      AllUsersPrograms
rem      AllUsersStartup
rem      Desktop
rem      Favorites
rem      Fonts
rem      MyDocuments
rem      NetHood
rem      PrintHood
rem      Programs
rem      Recent
rem      SendTo
rem      StartMenu
rem      Startup
rem      Templates

vbs tuta

Option Explicit
Dim result, objFSO, outFile, objFile 
result = InputBox("zapisi ovo:", "title", "default unos", 100, 100)
WScript.Echo result  

'Set objFSO = CreateObject("Scripting.FileSystemObject")

' How to write file
'outFile="c:\test\probator.txt"
'Set objFile = objFSO.CreateTextFile(outFile,True)
'objFile.Write "test string: " & result & vbCrLf
'objFile.Close


Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Open
objStream.WriteText result
objStream.SaveToFile "c:\test\probator.txt", 2



WScript.Echo "totovo"