This is non-sense FFI example of Haskell.
to compile:
$ ghc --make eject.hs c_eject.c
can not choise drive, just run:
$ ./eject
Last active
December 16, 2015 19:39
-
-
Save h-hirai/5486696 to your computer and use it in GitHub Desktop.
Ejecting CD-ROM by Haskell.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #include <windows.h> | |
| #include <winioctl.h> | |
| // #include <tchar.h> | |
| #include <stdio.h> | |
| // Prototypes | |
| // BOOL EjectVolume(TCHAR cDriveLetter); | |
| BOOL EjectVolume(char cDriveLetter); | |
| // HANDLE OpenVolume(TCHAR cDriveLetter); | |
| HANDLE OpenVolume(char cDriveLetter); | |
| BOOL LockVolume(HANDLE hVolume); | |
| BOOL DismountVolume(HANDLE hVolume); | |
| BOOL PreventRemovalOfVolume(HANDLE hVolume, BOOL fPrevent); | |
| BOOL AutoEjectVolume(HANDLE hVolume); | |
| BOOL CloseVolume(HANDLE hVolume); | |
| LPTSTR szVolumeFormat = TEXT("\\\\.\\%c:"); | |
| LPTSTR szRootFormat = TEXT("%c:\\"); | |
| LPTSTR szErrorFormat = TEXT("Error %d: %s\n"); | |
| void ReportError(LPTSTR szMsg) | |
| { | |
| // _tprintf(szErrorFormat, GetLastError(), szMsg); | |
| printf(szErrorFormat, GetLastError(), szMsg); | |
| } | |
| // HANDLE OpenVolume(TCHAR cDriveLetter) | |
| HANDLE OpenVolume(char cDriveLetter) | |
| { | |
| HANDLE hVolume; | |
| UINT uDriveType; | |
| // TCHAR szVolumeName[8]; | |
| // TCHAR szRootName[5]; | |
| char szVolumeName[8]; | |
| char szRootName[5]; | |
| DWORD dwAccessFlags; | |
| wsprintf(szRootName, szRootFormat, cDriveLetter); | |
| uDriveType = GetDriveType(szRootName); | |
| switch(uDriveType) { | |
| case DRIVE_REMOVABLE: | |
| dwAccessFlags = GENERIC_READ | GENERIC_WRITE; | |
| break; | |
| case DRIVE_CDROM: | |
| dwAccessFlags = GENERIC_READ; | |
| break; | |
| default: | |
| // _tprintf(TEXT("Cannot eject. Drive type is incorrect.\n")); | |
| printf(TEXT("Cannot eject. Drive type is incorrect.\n")); | |
| return INVALID_HANDLE_VALUE; | |
| } | |
| wsprintf(szVolumeName, szVolumeFormat, cDriveLetter); | |
| hVolume = CreateFile( szVolumeName, | |
| dwAccessFlags, | |
| FILE_SHARE_READ | FILE_SHARE_WRITE, | |
| NULL, | |
| OPEN_EXISTING, | |
| 0, | |
| NULL ); | |
| if (hVolume == INVALID_HANDLE_VALUE) | |
| ReportError(TEXT("CreateFile")); | |
| return hVolume; | |
| } | |
| BOOL CloseVolume(HANDLE hVolume) | |
| { | |
| return CloseHandle(hVolume); | |
| } | |
| #define LOCK_TIMEOUT 10000 // 10 Seconds | |
| #define LOCK_RETRIES 20 | |
| BOOL LockVolume(HANDLE hVolume) | |
| { | |
| DWORD dwBytesReturned; | |
| DWORD dwSleepAmount; | |
| int nTryCount; | |
| dwSleepAmount = LOCK_TIMEOUT / LOCK_RETRIES; | |
| // Do this in a loop until a timeout period has expired | |
| for (nTryCount = 0; nTryCount < LOCK_RETRIES; nTryCount++) { | |
| if (DeviceIoControl(hVolume, | |
| FSCTL_LOCK_VOLUME, | |
| NULL, 0, | |
| NULL, 0, | |
| &dwBytesReturned, | |
| NULL)) | |
| return TRUE; | |
| Sleep(dwSleepAmount); | |
| } | |
| return FALSE; | |
| } | |
| BOOL DismountVolume(HANDLE hVolume) | |
| { | |
| DWORD dwBytesReturned; | |
| return DeviceIoControl( hVolume, | |
| FSCTL_DISMOUNT_VOLUME, | |
| NULL, 0, | |
| NULL, 0, | |
| &dwBytesReturned, | |
| NULL); | |
| } | |
| BOOL PreventRemovalOfVolume(HANDLE hVolume, BOOL fPreventRemoval) | |
| { | |
| DWORD dwBytesReturned; | |
| PREVENT_MEDIA_REMOVAL PMRBuffer; | |
| PMRBuffer.PreventMediaRemoval = fPreventRemoval; | |
| return DeviceIoControl( hVolume, | |
| IOCTL_STORAGE_MEDIA_REMOVAL, | |
| &PMRBuffer, sizeof(PREVENT_MEDIA_REMOVAL), | |
| NULL, 0, | |
| &dwBytesReturned, | |
| NULL); | |
| } | |
| BOOL AutoEjectVolume(HANDLE hVolume) | |
| { | |
| DWORD dwBytesReturned; | |
| return DeviceIoControl( hVolume, | |
| IOCTL_STORAGE_EJECT_MEDIA, | |
| NULL, 0, | |
| NULL, 0, | |
| &dwBytesReturned, | |
| NULL); | |
| } | |
| // BOOL EjectVolume(TCHAR cDriveLetter) | |
| BOOL ejectVolume(char cDriveLetter) | |
| { | |
| HANDLE hVolume; | |
| BOOL fRemoveSafely = FALSE; | |
| BOOL fAutoEject = FALSE; | |
| // Open the volume. | |
| hVolume = OpenVolume(cDriveLetter); | |
| if (hVolume == INVALID_HANDLE_VALUE) | |
| return FALSE; | |
| // Lock and dismount the volume. | |
| if (LockVolume(hVolume) && DismountVolume(hVolume)) { | |
| fRemoveSafely = TRUE; | |
| // Set prevent removal to false and eject the volume. | |
| if (PreventRemovalOfVolume(hVolume, FALSE) && | |
| AutoEjectVolume(hVolume)) | |
| fAutoEject = TRUE; | |
| } | |
| // Close the volume so other processes can use the drive. | |
| if (!CloseVolume(hVolume)) | |
| return FALSE; | |
| if (fAutoEject) | |
| printf("Media in Drive %c has been ejected safely.\n", | |
| cDriveLetter); | |
| else { | |
| if (fRemoveSafely) | |
| printf("Media in Drive %c can be safely removed.\n", | |
| cDriveLetter); | |
| } | |
| return TRUE; | |
| } |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE ForeignFunctionInterface #-} | |
| main :: IO () | |
| main = ejectVolume 'd' >> return () | |
| foreign import ccall ejectVolume :: Char -> IO Bool |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment