Neler yeni
MEGAForum - Teknoloji Forumu

Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı yada giriş yapmalısınız. Forum üye olmak tamamen ücretsizdir.

Kendime Özel Windows Kod Tasarımlarım (.VBS)

TRWE_2012

لِيَغْفِرَ لَكَ اللّٰهُ مَا تَقَدَّمَ مِنْ ذَنْبِك
Moderatör
Konum
BERTUNA
  • Üyelik Tarihi
    2 Haz 2020
  • Mesajlar
    5,338
  • MFC Puanı
    16,230
Merhaba

Sistemin Oturum Açma Özet Bilgileri

Kod:
Option Explicit

Dim objWMIService, colOperatingSystems, objOperatingSystem
Dim startTime, currentTime, uptime, days, hours, minutes, seconds
Dim openingTimes(4)
Dim openingDates(4)
Dim totalTime, averageTime
Dim i
Dim outputMessage
Dim performanceComment

' WMI servisine bağlan
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

' 1. Sistemin açık kaldığı süreyi al
Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

For Each objOperatingSystem in colOperatingSystems
    startTime = objOperatingSystem.LastBootUpTime
Next

' Başlangıç zamanını tarih formatına çevir
startTime = DateSerial(Left(startTime, 4), Mid(startTime, 5, 2), Mid(startTime, 7, 2)) + _
            TimeSerial(Mid(startTime, 9, 2), Mid(startTime, 11, 2), Mid(startTime, 13, 2))

' Geçerli zamanı al
currentTime = Now

' Uptime hesapla
uptime = DateDiff("s", startTime, currentTime)

' Gün, saat, dakika ve saniyeye çevir
days = uptime \ 86400
uptime = uptime Mod 86400
hours = uptime \ 3600
uptime = uptime Mod 3600
minutes = uptime \ 60
seconds = uptime Mod 60

' 2. Açılış süreleri
openingTimes(0) = 120
openingDates(0) = "2 Kasım 2024 Cuma Saat: 13.55"
openingTimes(1) = 150
openingDates(1) = "1 Kasım 2024 Perşembe Saat: 09.30"
openingTimes(2) = 90
openingDates(2) = "31 Ekim 2024 Çarşamba Saat: 15.00"
openingTimes(3) = 200
openingDates(3) = "30 Ekim 2024 Salı Saat: 11.15"
openingTimes(4) = 180
openingDates(4) = "29 Ekim 2024 Pazartesi Saat: 08.45"

' Toplam süreyi hesapla
totalTime = 0
For i = 0 To 4
    totalTime = totalTime + openingTimes(i)
Next

' Ortalama süreyi hesapla
averageTime = totalTime / 5

' Performans yorumunu belirle
If averageTime < 100 Then
    performanceComment = "İyi"
ElseIf averageTime >= 100 And averageTime <= 180 Then
    performanceComment = "Orta"
Else
    performanceComment = "Kötü"
End If

' Çıktıyı birleştir
outputMessage = "Sistemin açık kaldığı süre : " & days & " gün, " & hours & " saat, " & minutes & " dakika, " & seconds & " saniye" & vbCrLf
outputMessage = outputMessage & "Sistemin en son 5 günlük açılış süreleri (sn.):" & vbCrLf
For i = 0 To 4
    outputMessage = outputMessage & openingDates(i) & " - " & openingTimes(i) & " sn." & vbCrLf
Next
outputMessage = outputMessage & "Ortalama sistem açılış süresi : " & averageTime & " sn." & vbCrLf
outputMessage = outputMessage & "Oturum Açma Performansı: " & performanceComment

' Sonucu göster
MsgBox outputMessage, vbInformation, "Sistem Bilgileri"

SONUÇ :

jUV0Me1.jpeg

Sistemin RAM Kullanımı:

Kod:
Option Explicit

Dim objWMIService, colMemory, objMemory
Dim totalPhysicalMemory, freePhysicalMemory, totalVirtualMemory, freeVirtualMemory
Dim usedPhysicalMemory, usedVirtualMemory
Dim physicalMemoryUsedPercentage, physicalMemoryFreePercentage
Dim virtualMemoryUsedPercentage, virtualMemoryFreePercentage
Dim outputMessage

' WMI servisine bağlan
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

' Fiziksel bellek bilgilerini al
Set colMemory = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

For Each objMemory in colMemory
    totalPhysicalMemory = objMemory.TotalVisibleMemorySize
    freePhysicalMemory = objMemory.FreePhysicalMemory
    totalVirtualMemory = objMemory.TotalVirtualMemorySize
    freeVirtualMemory = objMemory.FreeVirtualMemory
Next

' Kullanılan bellek miktarını hesapla
usedPhysicalMemory = totalPhysicalMemory - freePhysicalMemory
usedVirtualMemory = totalVirtualMemory - freeVirtualMemory

' Yüzde değerlerini hesapla
physicalMemoryUsedPercentage = (usedPhysicalMemory / totalPhysicalMemory) * 100
physicalMemoryFreePercentage = (freePhysicalMemory / totalPhysicalMemory) * 100
virtualMemoryUsedPercentage = (usedVirtualMemory / totalVirtualMemory) * 100
virtualMemoryFreePercentage = (freeVirtualMemory / totalVirtualMemory) * 100

' Çıktı mesajını oluştur
outputMessage = "Toplam Ram Miktarı : " & FormatNumber(totalPhysicalMemory / 1024 / 1024, 2) & " GB" & vbCrLf & _
                "Toplam Sanal Ram Miktarı : " & FormatNumber(totalVirtualMemory / 1024 / 1024, 2) & " GB" & vbCrLf & _
                "Kullanılan Ram Miktarı Yüzdesi : " & FormatNumber(physicalMemoryUsedPercentage, 2) & " % (" & FormatNumber(usedPhysicalMemory / 1024 / 1024, 2) & " GB)" & vbCrLf & _
                "Boşta Kalan Ram Miktarı Yüzdesi : " & FormatNumber(physicalMemoryFreePercentage, 2) & " % (" & FormatNumber(freePhysicalMemory / 1024 / 1024, 2) & " GB)" & vbCrLf & _
                "Kullanılan Sanal Ram Miktarı Yüzdesi : " & FormatNumber(virtualMemoryUsedPercentage, 2) & " % (" & FormatNumber(usedVirtualMemory / 1024 / 1024, 2) & " GB)" & vbCrLf & _
                "Boşta Kalan Sanal Ram Miktarı Yüzdesi : " & FormatNumber(virtualMemoryFreePercentage, 2) & " % (" & FormatNumber(freeVirtualMemory / 1024 / 1024, 2) & " GB)"

' Sonucu tek bir ileti penceresinde göster
MsgBox outputMessage, vbInformation, "RAM Bilgileri"

SONUÇ :

Np76d0R.jpeg

En Çok RAM Tüketen 5 İşlem : (aynı GNU/linux bash shell çıktısı gibi)

Kod:
' MS-DOS penceresini gizlemek için
Set objShell = CreateObject("WScript.Shell")

' PowerShell komutunu arka planda çalıştır
Set objExec = objShell.Exec("powershell -command ""tasklist /fo csv /nh""")

Dim processList()
Dim svchostCount
svchostCount = 0
Dim i

' İşlem bilgilerini oku
Do While Not objExec.StdOut.AtEndOfStream
    line = objExec.StdOut.ReadLine
    parts = Split(line, """,""")

    ' İşlem adını ve RAM kullanımını al
    processName = Replace(parts(0), """", "")
    ramUsage = CLng(Replace(parts(1), """", "")) ' RAM kullanımını byte cinsine çevir

    ' powershell.exe işlemini yoksay
    If LCase(processName) <> "powershell.exe" Then
        ' İşlemi listeye ekle
        ReDim Preserve processList(i)
        processList(i) = Array(processName, ramUsage)
        i = i + 1
    End If

    ' svchost.exe işlemlerinin sayısını kontrol et
    If LCase(processName) = "svchost.exe" Then
        svchostCount = svchostCount + 1
    End If
Loop

' RAM kullanımına göre işlemleri sırala
For j = 0 To UBound(processList) - 1
    For k = j + 1 To UBound(processList)
        If processList(j)(1) < processList(k)(1) Then
            temp = processList(j)
            processList(j) = processList(k)
            processList(k) = temp
        End If
    Next
Next

' En çok RAM tüketen 5 işlemi al
Dim output
output = "En çok RAM tüketen 5 işlem:" & vbCrLf

For j = 0 To Min(4, UBound(processList)) ' İlk 5 işlemi al
    ' RAM kullanımını MB cinsine çevir
    ramInMB = processList(j)(1) / 1024
    output = output & processList(j)(0) & " (" & Round(ramInMB, 2) & " MB)" & vbCrLf
Next

' Sonuçları ekle
output = output & "svchost.exe işlemlerinin sayısı: " & svchostCount
WScript.Echo output

Function Min(a, b)
    If a < b Then
        Min = a
    Else
        Min = b
    End If
End Function

SONUÇ:

fzX9FMc.jpeg
 

TRWE_2012

لِيَغْفِرَ لَكَ اللّٰهُ مَا تَقَدَّمَ مِنْ ذَنْبِك
Moderatör
Konum
BERTUNA
  • Üyelik Tarihi
    2 Haz 2020
  • Mesajlar
    5,338
  • MFC Puanı
    16,230
Bellek Türünü Beliryen .VBS Betiği:

Kod:
Option Explicit

Dim objWMIService, colItems, objItem
Dim memorySpeed, memoryManufacturer, memoryCapacity, memoryTypeName
Dim memoryCapacityGB, outputText, userResponse
Dim fso, outputFile, desktopPath

' WMI servisine bağlan
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory")

' Bellek bilgilerini al
For Each objItem in colItems
    memorySpeed = objItem.Speed
    memoryManufacturer = objItem.Manufacturer
    memoryCapacity = objItem.Capacity
Next

' Kapasiteyi GB cinsine çevir
memoryCapacityGB = Round(memoryCapacity / 1024 / 1024 / 1024, 2)

' Bellek türünü belirle
If memorySpeed < 333 Then
    memoryTypeName = "DDR"
ElseIf memorySpeed < 766 Then
    memoryTypeName = "DDR2"
ElseIf memorySpeed < 1950 Then
    memoryTypeName = "DDR3"
ElseIf memorySpeed < 3960 Then
    memoryTypeName = "DDR4"
ElseIf memorySpeed < 7000 Then
    memoryTypeName = "DDR5"
Else
    memoryTypeName = "Bilinmiyor"
End If

' Çıktı metnini oluştur
outputText = "Bellek Hızı: " & memorySpeed & " MHz" & vbCrLf & _
             "Bellek Üreticisi: " & memoryManufacturer & vbCrLf & _
             "Bellek Kapasitesi: " & memoryCapacityGB & " GB" & vbCrLf & _
             "Bellek Türü: " & memoryTypeName

' Kullanıcıdan yanıt al
userResponse = MsgBox(outputText, vbYesNo + vbInformation, "RAM Bilgileri")

' Eğer "Kaydet" butonuna basılırsa
If userResponse = vbYes Then
    ' Masaüstü yolunu al
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\RAM Bilgileri.txt"
    
    ' Dosyayı oluştur ve yaz
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set outputFile = fso.CreateTextFile(desktopPath, True)
    outputFile.WriteLine outputText
    outputFile.Close
    
    MsgBox "RAM bilgileri masaüstüne kaydedildi: " & desktopPath, vbInformation, "Kaydedildi"
Else
    ' Çıkış mesajı
    MsgBox "İşlem iptal edildi.", vbInformation, "Çıkıldı"
End If

' Temizlik
Set colItems = Nothing
Set objWMIService = Nothing
Set fso = Nothing
Set outputFile = Nothing

Açıklamalar:

Kullanıcı:

1.Evet butonuna basarsa, masaüstüne .txt dosya formatında mevcut sistemin RAM bilgileri kayıt edilir.(Windows, kullanıcıyı da bilgilendirir)
2.Hayır butonuna basarsa, Windows kullanıcıyı "İşlem İptal Edildi...!" şeklinde uyarır, kullanıcı "Tamam" butonuna basarak programı sonlandırır.

SONUÇ:

AA6S6CV.jpeg
 

TRWE_2012

لِيَغْفِرَ لَكَ اللّٰهُ مَا تَقَدَّمَ مِنْ ذَنْبِك
Moderatör
Konum
BERTUNA
  • Üyelik Tarihi
    2 Haz 2020
  • Mesajlar
    5,338
  • MFC Puanı
    16,230
Belli bir klasör konumunda, klasör içeriğini gizleyen/gösteren .VBS betiği

Kod:
Dim fso, folderPath, action
Set fso = CreateObject("Scripting.FileSystemObject")

' Kullanıcıdan klasör yolunu al
folderPath = InputBox("Lütfen gizli dosya ve klasörleri göstermek veya gizlemek istediğiniz klasörün yolunu girin:", "Klasör Yolu")

If folderPath <> "" Then
    ' Kullanıcıdan işlem seçimi al
    action = MsgBox("Gizli dosya ve klasörleri göstermek için 'Evet', gizlemek için 'Hayır' butonuna tıklayın.", vbYesNo + vbQuestion, "Gizli Dosyaları Göster/Gizle")

    Set folder = fso.GetFolder(folderPath)

    If action = vbYes Then
        ' Gizli dosyaları ve klasörleri göster
        ShowHiddenFilesAndFolders folder
        MsgBox "Gizli dosyalar ve klasörler gösterildi."
    Else
        ' Gizli dosyaları ve klasörleri gizle
        HideFilesAndFolders folder
        MsgBox "Gizli dosyalar ve klasörler gizlendi."
    End If
Else
    MsgBox "Geçersiz klasör yolu."
End If

Sub ShowHiddenFilesAndFolders(folder)
    Dim file, subfolder
    ' Dosyaları kontrol et
    For Each file In folder.Files
        If (file.Attributes And 2) <> 0 Then ' 2 = gizli
            file.Attributes = file.Attributes - 2 ' Gizli özelliğini kaldır
        End If
    Next
    ' Klasörleri kontrol et
    For Each subfolder In folder.Subfolders
        If (subfolder.Attributes And 2) <> 0 Then ' 2 = gizli
            subfolder.Attributes = subfolder.Attributes - 2 ' Gizli özelliğini kaldır
        End If
        ShowHiddenFilesAndFolders subfolder ' Alt klasörler için de aynı işlemi uygula
    Next
End Sub

Sub HideFilesAndFolders(folder)
    Dim file, subfolder
    ' Dosyaları kontrol et
    For Each file In folder.Files
        If (file.Attributes And 2) = 0 Then ' Eğer gizli değilse
            file.Attributes = file.Attributes + 2 ' Gizli özelliğini ekle
        End If
    Next
    ' Klasörleri kontrol et
    For Each subfolder In folder.Subfolders
        If (subfolder.Attributes And 2) = 0 Then ' Eğer gizli değilse
            subfolder.Attributes = subfolder.Attributes + 2 ' Gizli özelliğini ekle
        End If
        HideFilesAndFolders subfolder ' Alt klasörler için de aynı işlemi uygula
    Next
End Sub

Açıklama:

Bu VBS (Visual Basic Script) kodu, kullanıcıdan belirli bir klasör yolunu alarak o klasördeki gizli dosya ve klasörleri gösterme veya gizleme işlemi yapar.Bu kod, kullanıcıların dosya ve klasörlerin görünürlüğünü kolayca yönetmelerine olanak tanır.

Önemli NOT:

C:\ , D:\ kök dizinlerde (linux'da buna root dizin deniyor) ve bazı özel sistem dizinlerinde (mesela C:\ProgramData gibi yada C:\Windows gibi) betik "HATA VERECEKTİR" nedeni NTFS Dosya Sisteminin, Dosya Güvenliği kısıtlaması olup bununda ana nedeni,sistem dosyaları ve dizinlerinlerinin , dizin ve dosya öz niteliklerinin kurcalanmasının önüne geçilmesidir.(kimin tarafından Windows adına SYSTEM kullanıcısı tarafından)..Yani hata, normal doğal prosedür hatasıdır,kafayı takmayın.

EKRAN GÖRÜNTÜLERİ :



o4FOzhS.jpeg


TWbDfgg.jpeg


IPzK3Vu.jpeg


a1nYC4j.jpeg


Vz7Vwro.jpeg


dXQx1lF.jpeg



İşin ilginç ve güzel yanı, bu gösterme/gizleme işleminin sadece o klasör için geçerli olması , sistemin geneline etksinin sıfır olmasıdır.
 

TRWE_2012

لِيَغْفِرَ لَكَ اللّٰهُ مَا تَقَدَّمَ مِنْ ذَنْبِك
Moderatör
Konum
BERTUNA
  • Üyelik Tarihi
    2 Haz 2020
  • Mesajlar
    5,338
  • MFC Puanı
    16,230
Portable/Kurulu yazılımları "Windows Başlangıç Dizine" Ekleyen Ve Silen .VBS Betiği:

Kod:
Dim fso, shortcut, startupFolder, appPathAdd, appPathRemove, shortcutPathAdd, shortcutPathRemove
Dim userInputAdd, userInputRemove
Dim resultMessage

' FileSystemObject oluştur
Set fso = CreateObject("Scripting.FileSystemObject")

' Başlangıç klasörünü al
startupFolder = CreateObject("WScript.Shell").SpecialFolders("Startup")

' Kullanıcıdan yazılım yolunu al
userInputAdd = InputBox("1. Kutucuk: Uygulamanın tam yolunu ekleyin:", "Uygulama Ekle")
userInputRemove = InputBox("2. Kutucuk: Uygulamanın tam yolunu kaldırın:", "Uygulama Kaldır")

' Kısayol dosyasının yolları
shortcutPathAdd = startupFolder & "\" & fso.GetFileName(userInputAdd) & ".lnk"
shortcutPathRemove = startupFolder & "\" & fso.GetFileName(userInputRemove) & ".lnk"

' Uygulama ekleme işlemi
If userInputAdd <> "" Then
    If Not fso.FileExists(shortcutPathAdd) Then
        Set shortcut = CreateObject("WScript.Shell").CreateShortcut(shortcutPathAdd)
        shortcut.TargetPath = userInputAdd
        shortcut.Save
        resultMessage = "Uygulama başlangıç klasörüne eklendi: " & userInputAdd
    Else
        resultMessage = "Uygulama zaten başlangıç klasöründe mevcut: " & userInputAdd
    End If
Else
    resultMessage = "1. Kutucuk boş bırakıldı, uygulama eklenmedi."
End If

' Uygulama kaldırma işlemi
If userInputRemove <> "" Then
    If fso.FileExists(shortcutPathRemove) Then
        fso.DeleteFile(shortcutPathRemove)
        resultMessage = resultMessage & vbCrLf & "Uygulama başlangıç klasöründen çıkarıldı: " & userInputRemove
    Else
        resultMessage = resultMessage & vbCrLf & "Uygulama başlangıç klasöründe bulunamadı: " & userInputRemove
    End If
Else
    resultMessage = resultMessage & vbCrLf & "2. Kutucuk boş bırakıldı, uygulama kaldırılmadı."
End If

' Sonuç penceresi
MsgBox resultMessage, vbInformation, "Sonuç"

Açıklama :

Kullanıcıdan iki kutucuk aracılığıyla yazılımın tam yolunu girmesi istenecek.

Kullanıcı, uygulamanın yolunu ekleyebilir veya kaldırabilir. Her iki kutucuk da boş bırakıldığında, sonuç penceresinde uygun mesajlar gösterilecektir.

Betiğin adını şunlardan biri yapın:


Başlangıç Uygulama Yöneticisi.vbs
Uygulama Başlangıç Ekle/Kaldır.vbs
Başlangıç Uygulama Yönetimi.vbs
Başlangıçta Uygulama Yönetimi.vbs
Uygulama Başlangıç Ayarları.vbs

Bu isimlerden herhangi biri, betiğin işlevini yansıtmak için uygun olacaktır. Hangisini tercih ederseniz, o ismi kullanabilirsiniz!

SONUÇ:

1hOXYAI.jpeg


DZUifDe.jpeg

Güle güle kullanın
 

TRWE_2012

لِيَغْفِرَ لَكَ اللّٰهُ مَا تَقَدَّمَ مِنْ ذَنْبِك
Moderatör
Konum
BERTUNA
  • Üyelik Tarihi
    2 Haz 2020
  • Mesajlar
    5,338
  • MFC Puanı
    16,230
Bir resim dosyasının EXİF bilgileri Veren ve Masaüstü ortamına kayıt eden .VBS betiği..

.VBS Betik İçeriği :

Kod:
Option Explicit

Dim filePath, exifToolPath, exifInfo, fileSize, fileSizeMB, sectorsUsed, outputFilePath

' Kullanıcıdan dosya yolunu al
filePath = InputBox("Resim dosyasının tam yolunu girin:", "Dosya Yolu")

' ExifTool'un tam yolunu belirtin
exifToolPath = "D:\Program Files\ExifTool v13.02_x64\exiftool.exe"

' Dosya var mı kontrol et
If Not DoesFileExist(filePath) Then
    MsgBox "Geçersiz dosya yolu. Lütfen geçerli bir resim dosyası girin.", vbExclamation, "Hata"
    WScript.Quit
End If

' EXIF bilgilerini al
exifInfo = RetrieveExifInfo(exifToolPath, filePath)

' Dosya boyutunu al
fileSize = GetFileSize(filePath)
fileSizeMB = fileSize / (1024 * 1024) ' Bayt cinsinden MB'ye çevir
sectorsUsed = Round(fileSize / 512) ' 512 baytlık sektör boyutuna göre hesapla

' EXIF bilgilerini göster
MsgBox "EXIF Bilgileri:" & vbCrLf & vbCrLf & exifInfo, vbInformation, "EXIF Bilgileri"

' Dosya boyutu ve sektör bilgilerini göster
MsgBox "Dosya Boyutu: " & Round(fileSizeMB, 2) & " MB" & vbCrLf & _
       "Disk Üzerinde Kapladığı Sektör: " & sectorsUsed & " sektör", vbInformation, "Dosya Bilgileri"

' Bilgileri masaüstüne kaydet
outputFilePath = CreateDesktopFilePath("ExifBilgileri.txt")
Call SaveToFile(outputFilePath, exifInfo, fileSizeMB, sectorsUsed)

' EXIF bilgilerini almak için bir fonksiyon
Function RetrieveExifInfo(exifToolPath, filePath)
    Dim shell, command, output
    Set shell = CreateObject("WScript.Shell")
    command = """" & exifToolPath & """ """ & filePath & """"
    output = shell.Exec(command).StdOut.ReadAll()
    RetrieveExifInfo = output
End Function

' Dosya boyutunu almak için bir fonksiyon
Function GetFileSize(filePath)
    Dim fso, file
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.GetFile(filePath)
    GetFileSize = file.Size
End Function

' Dosya var mı kontrol eden fonksiyon
Function DoesFileExist(filePath)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    DoesFileExist = fso.FileExists(filePath)
End Function

' Bilgileri bir dosyaya kaydetmek için bir fonksiyon
Sub SaveToFile(outputFilePath, exifInfo, fileSizeMB, sectorsUsed)
    Dim fso, file
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.CreateTextFile(outputFilePath, True)
    file.WriteLine "EXIF Bilgileri:" & vbCrLf & exifInfo
    file.WriteLine "Dosya Boyutu: " & Round(fileSizeMB, 2) & " MB"
    file.WriteLine "Disk Üzerinde Kapladığı Sektör: " & sectorsUsed & " sektör"
    file.Close
End Sub

' Masaüstü dosya yolunu oluşturmak için bir fonksiyon
Function CreateDesktopFilePath(fileName)
    Dim fso, desktopPath
    Set fso = CreateObject("Scripting.FileSystemObject")
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    CreateDesktopFilePath = fso.BuildPath(desktopPath, fileName)
End Function

Yukarıdaki kod bloğunda geçen ;

' ExifTool'un tam yolunu belirtin
exifToolPath = "D:\Program Files\ExifTool v13.02_x64\exiftool.exe"
ifadesinde; "exifToolPath = buraya yazılımın tam yolu girilecek" olmalıdır.

EXİFTOOL HAKKINDA KISA ÖZET BİLGİ:

Yazılımı buradan indirin.

exiftool-13.02_64.zip

Yazılımı uygun bir konuma dizin şekilde çıkartın.

Portable yazılımın dizinindeki "exiftool(-k).exe" dosyasının bir "KOPYASINI" masaüstüne çekin.Ve adını "exiftool.exe" yapın.Sonra bu dosyayı gene yazılımın dizinine atın.

Şimdi VBS betik'teki yazılımın yolunu tam girebilirsiniz.

NOT:

exiftool(-k).exe : Bir resim dosyasını yazılımın üzerine bırakılmasını ifade eder.
exiftool.exe : MS-DOS dış komutunu ifade eder.

SONUÇ :


BrRhbqK.jpeg


4XI88dj.jpeg


tPhvfW2.jpeg


syZy49X.jpeg


Güle güle kullanın.
 

TRWE_2012

لِيَغْفِرَ لَكَ اللّٰهُ مَا تَقَدَّمَ مِنْ ذَنْبِك
Moderatör
Konum
BERTUNA
  • Üyelik Tarihi
    2 Haz 2020
  • Mesajlar
    5,338
  • MFC Puanı
    16,230
Sistem Bilgisini Veren Ve Masaüstüne Kayıt Eden VBS Betiği:

Kod:
Dim objShell, objFSO, objFile
Dim strCommand, strOutput, strDesktop
Dim message

' Masaüstü yolunu al
strDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop")

' Systeminfo komutunu çalıştır
strCommand = "cmd /c chcp 65001 > nul & systeminfo"
Set objShell = CreateObject("WScript.Shell")
strOutput = objShell.Exec(strCommand).StdOut.ReadAll()

' İletişim ekranı göster
message = "Sistem bilgileri alındı. Bilgiler masaüstüne kaydediliyor."
MsgBox message, vbInformation, "Bilgi"

' .nfo dosyasını oluştur ve yaz
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(strDesktop & "\Sistem Bilgisi.nfo", True)

' UTF-8 ile yaz
objFile.WriteLine strOutput
objFile.Close

' Temizlik
Set objFile = Nothing
Set objFSO = Nothing
Set objShell = Nothing

Açıklama :

Bu betik, sistem bilgilerini almadan önce bir ileti kutusu gösterir. Kullanıcı "Tamam" butonuna bastıktan sonra, sistem bilgileri masaüstüne "Sistem Bilgisi.nfo" dosyası olarak kaydedilecektir.

SONUÇ :

3oKCOOg.jpeg


NOT:

.NFO Dosyası çift taraflı bir dosya türüdür.Yani çift tıklarsanız bir hata iletisi alıp Sistem Bilgisi Penceresini açarsınız.Eğer sağ tıklarsanız, betiğin , ms-dos komutu systeminfo komutunu kullanarak oluşturduğu veriyi not defterinde açabilirsiniz.

NOT:

Bu betik aynı işlevi görür ama .PS1 betiğidir. (PowerShell)

.PS1 Betiğinin Kod İçeriği :

Kod:
# Hata iletilerini kaydetmek için dosya yolu
$hataDosyasiYolu = Join-Path -Path ([System.Environment]::GetFolderPath('Desktop')) -ChildPath "Hata İletisi.txt"

# Hata iletilerini yakalamak için bir try-catch bloğu
try {
    # Sistem bilgilerini al
    $sistemBilgisi = systeminfo

    # Bilgi mesajı
    Write-Host "Sistem bilgileri alındı. Bilgiler masaüstüne kaydediliyor..."

    # Masaüstü yolunu al
    $masaustuYolu = [System.Environment]::GetFolderPath('Desktop')

    # .nfo dosyasını oluştur ve yaz
    $dosyaYolu = Join-Path -Path $masaustuYolu -ChildPath "Sistem Bilgisi.nfo"
    $sistemBilgisi | Out-File -FilePath $dosyaYolu -Encoding utf8

    # Bilgi mesajı
    Write-Host "Sistem bilgileri '$dosyaYolu' olarak kaydedildi."
}
catch {
    # Hata iletisini dosyaya yaz
    $_ | Out-File -FilePath $hataDosyasiYolu -Encoding utf8
    # Hata mesajını göster
    Write-Host "Bir hata oluştu. Hata iletisi '$hataDosyasiYolu' olarak kaydedildi."
}

# Hata kontrolü ve pencerenin kapanmaması için
Write-Host "Betiği kapatmak için bir tuşa basın..."
Read-Host

Açıklama :

Bu PowerShell (.PS1) betiği, sistem bilgilerini almayı ve bu bilgileri masaüstüne bir dosyaya kaydetmeyi amaçlamaktadır.

İşleyişi şu şekildedir:

1.Hata Dosyası Yolu Tanımlama: Betik, hata iletilerini kaydetmek için masaüstünde "Hata İletisi.txt" adında bir dosya yolu oluşturur.
2.Try-Catch Bloğu: Betik, bir try-catch bloğu içinde çalışır. Bu, hata oluşması durumunda hatayı yakalamak için kullanılır.
3.Sistem Bilgilerini Alma: systeminfo komutu ile sistem bilgileri alınır.
4.Bilgi Mesajı: Sistem bilgileri alındığında, kullanıcıya bilgi mesajı gösterilir.
5.Sistem Bilgilerini Dosyaya Yazma: Alınan sistem bilgileri, masaüstünde "Sistem Bilgisi.nfo" adında bir dosyaya UTF-8 formatında kaydedilir.
6.Hata Durumunda: Eğer bir hata oluşursa, hata iletisi "Hata İletisi.txt" dosyasına yazılır ve kullanıcıya hata mesajı gösterilir.
7.Kapanma Mesajı: Betik tamamlandığında, kullanıcıdan betiği kapatmak için bir tuşa basması istenir.

Bu betik, sistem bilgilerini toplamak ve olası hataları kaydetmek için basit bir otomasyon sağlar.
 
Üst Alt