Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.10.2015, 02:36   #1
JPCool
Пользователь
 
Регистрация: 06.09.2015
Сообщений: 31
Счастье CryptoAPI

Добрый день, делаю инициализацию для работы с CryptoApi вот так:

Код:
type
  HCRYPTPROV  = ULONG;
  PHCRYPTPROV = ^HCRYPTPROV;
  HCRYPTKEY   = ULONG;
  PHCRYPTKEY  = ^HCRYPTKEY;
  HCRYPTHASH  = ULONG;
  PHCRYPTHASH = ^HCRYPTHASH;

var
 BaseCryptProv:HCRYPTPROV;
 BaseCryptKey:HCRYPTKEY;
 MyID:String[255];

Function InitializationCryptBase:Boolean;
var
 Hash:HCRYPTHASH;
 L:Integer;
begin
Result:=False;
try
if CryptAcquireContext(@BaseCryptProv, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) then
   begin 
   if CryptCreateHash(BaseCryptProv, CALG_SHA, 0, 0, @Hash) then
      begin                        
      if CryptHashData(Hash, @MyID[1], length(MyID), 0) then
         begin   
         if CryptDeriveKey(BaseCryptProv, CALG_RC4, hash, 0, @BaseCryptKey) then
            begin 
            Result:=True;
            end;
         CryptDestroyHash(Hash);
         end;
      end;
   end;
L:=GetLastError;
WriteErrorReportStr('Error Last - '+IntToStr(L));
except
end;
end;
Пишу все чудо на XE5 все отлично от работы юзерского акуанта. но если запустить файл из под системы (LOCAL SERVICE в виде сервиса) то происходит ощибка на вызове CryptCreateHash с номером 87.

Последний раз редактировалось Stilet; 19.10.2015 в 09:36.
JPCool вне форума Ответить с цитированием
Старый 19.10.2015, 09:43   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
ERROR_INVALID_PARAMETER

87 (0x57)

The parameter is incorrect.
Ты проверял BaseCryptProv? Провайдер вообще инициализировался?

Цитата:
@BaseCryptProv
Кстати, а почему ты указатель передаешь?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 20.10.2015, 02:14   #3
JPCool
Пользователь
 
Регистрация: 06.09.2015
Сообщений: 31
Счастье

Цитата:
Сообщение от Stilet Посмотреть сообщение
Ты проверял BaseCryptProv? Провайдер вообще инициализировался?


Кстати, а почему ты указатель передаешь?

Да функция (CryptAcquireContext) Вернула True и BaseCryptProv инициализировался.

Передаю указать так как функция описана у меня так:

function CryptAcquireContext(phProv :PHCRYPTPROV;
pszContainer :LPAWSTR;
pszProvider :LPAWSTR;
dwProvType :DWORD;
dwFlags :DWORD) :BOOL;stdcall;

Сама переменная BaseCryptProv = HCRYPTPROV
соотсветвенно вызов можно передать указателем? или я не прав?

Провел маштабные тесты и получилось так.

Win 7 32/64 bit все отлично.
win 8 32 бит все отлично.

win 8 64 bit и win 10 64 bit проблема сохранилась. но от юзера опять же все в порядке. Куда копать то?

Последний раз редактировалось JPCool; 20.10.2015 в 02:45.
JPCool вне форума Ответить с цитированием
Старый 20.10.2015, 08:50   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
соотсветвенно вызов можно передать указателем? или я не прав?
Не ну смотря как опишешь. У тебя CryptAcquireContext() по указателю, а CryptCreateHash() и дальше - нет.
Я работаю так: http://www.programmersforum.ru/showp...8&postcount=45
Может и тебе стоит подхватить такого рода гриппчик?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 21.10.2015, 03:27   #5
JPCool
Пользователь
 
Регистрация: 06.09.2015
Сообщений: 31
По умолчанию

Цитата:
Сообщение от Stilet Посмотреть сообщение
Не ну смотря как опишешь. У тебя CryptAcquireContext() по указателю, а CryptCreateHash() и дальше - нет.
Я работаю так: http://www.programmersforum.ru/showp...8&postcount=45
Может и тебе стоит подхватить такого рода гриппчик?
Переписал все под JwaWinCrypt аналогично проблемы в win 8 64

PHP код:


Function InitializationCryptBase:Boolean;
var
 
Hash:HCRYPTHASH;
 
L:Integer;
begin
Result
:=False;
try
WriteErrorReportStr('Start CryptAcquireContext - '+IntTostr(BaseCryptProv));
if 
CryptAcquireContext(BaseCryptProvnilnilPROV_RSA_FULLCRYPT_VERIFYCONTEXTthen
   begin
   WriteErrorReportStr
('CryptAcquireContext - '+IntTostr(BaseCryptProv));
   if 
CryptCreateHash(BaseCryptProvCALG_SHA00Hashthen
      begin
      WriteErrorReportStr
('CryptCreateHash');
      if 
CryptHashData(Hash, @TrRec.MyID[1], length(TrRec.MyID), 0then
         begin
         WriteErrorReportStr
('CryptHashData');
         if 
CryptDeriveKey(BaseCryptProvCALG_RC4hash0BaseCryptKeythen
            begin
            WriteErrorReportStr
('CryptDeriveKey');
            
Result:=True;
            
end;
         
CryptDestroyHash(Hash);
         
end;
      
end;
   
end;
L:=GetLastError;
WriteErrorReportStr('Error Last - '+IntToStr(L));
except
end
;
end
JPCool вне форума Ответить с цитированием
Старый 21.10.2015, 04:41   #6
JPCool
Пользователь
 
Регистрация: 06.09.2015
Сообщений: 31
По умолчанию

Нашел проблему но не понял ее сути.

Если создать серсис стандартными средствами делфи, то есть ехе файл VCL Service то данный код работает отлично (32/64 bit на win 8). Но в моем случаи это 64 битная DLL каторую запускает Менеджер служб SVCHOST.EXE.

Причем код инициализации InitializationCryptBase вставил до станадратных вызовов VCL.

Цитата:
program Project2;

uses
Vcl.SvcMgr,
BaseUnit,
Unit2 in 'Unit2.pas' {Service2: TService},
Version in 'Z:\Version\Version.pas';

{$R *.RES}

begin

InitializationCryptBase;

if not Application.DelayInitialize or Application.Installing then
Application.Initialize;
Application.CreateForm(TService2, Service2);
Application.Run;
end.
Аналогично делаю в DLL.


Цитата:

var
DispatchTable :_SERVICE_TABLE_ENTRYW;
sst : SERVICE_STATUS;
sstHandle : SERVICE_STATUS_HANDLE;

procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;
begin
try
case Opcode of

SERVICE_CONTROL_STOP:
begin
sst.dwWin32ExitCode:=0;
sst.dwCurrentState := SERVICE_STOPPED;
sst.dwCheckPoint :=0;
sst.dwWaitHint :=0;
SetServiceStatus(sstHandle,sst);
exit;
end;

SERVICE_CONTROL_INTERROGATE : ;
end;

SetServiceStatus(sstHandle,sst);
except
end;
end;


procedure ServiceMain(argc : DWORD;var argv : array of PWChar);stdcall;
var
S:WideString;
begin
try
sst.dwServiceType:=SERVICE_WIN32;
sst.dwCurrentState:=SERVICE_START_P ENDING;
sst.dwControlsAccepted:=SERVICE_ACC EPT_STOP;
sst.dwWin32ExitCode:=0;
sst.dwServiceSpecificExitCode:=0;
sst.dwCheckPoint:=0;
sst.dwWaitHint:=0;
S:='CMD';
sstHandle:=RegisterServiceCtrlHandl er(PWidechar(S),@ServiceCtrlHandler );
if sstHandle <> 0 then
begin
sst.dwCurrentState:=SERVICE_RUNNING ;
sst.dwCheckPoint:=0;
sst.dwWaitHint:=0;
SetServiceStatus(sstHandle,sst);
//--- Code Here ----//

//------------------//
repeat
sleep(500);
until sst.dwCurrentState = SERVICE_STOPPED;
end;
except
end;
end;


Exports ServiceMain;


var
S:String;
begin
if InitializationCryptBase=False then
WriteErrorReportStr('Initialization CryptBase Error');

DispatchTable.lpServiceName:='CMD';
DispatchTable.lpServiceProc:=@Servi ceMain;
StartServiceCtrlDispatcher(Dispatch Table);
end.

Прописываю сервис так.

Цитата:
[HKEY_LOCAL_MACHINE\SYSTEM\ControlSe t001\Services\syscmdx]

"Description"="syscmdx"
"DisplayName"="syscmdx"
"ErrorControl"=dword:00000001
"Group"="syscmdx"
"ImagePath"= C:\Windows\system32\svchost.exe -k LocalService
"ObjectName"="LocalSystem"
"RequiredPrivileges"=SeDebugPrivile ge SeShutdownPrivilege
"Start"=dword:00000003
"Type"=dword:00000110


[HKEY_LOCAL_MACHINE\SYSTEM\ControlSe t001\Services\syscmdx\Parameters]
"ServiceDll"= c:\programdata\test.dll

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

[HKEY_LOCAL_MACHINE\SOFTWARE\Microso ft\Windows NT\CurrentVersion\Svchost]

LocalService = syscmdx
nsi
WdiServiceHost
w32time
EventSystem
RemoteRegistry
WinHttpAutoProxySvc
SstpSvc
netprofm
lltdsvc
THREADORDER
FontCache
fdphost
bthserv
WebClient

Наверно я не провожу какую то дополнительную инициализацию чего либо и т.д. Куда смотреть что копать? )

Последний раз редактировалось JPCool; 21.10.2015 в 04:53.
JPCool вне форума Ответить с цитированием
Старый 04.07.2016, 16:58   #7
AOXOA
Новичок
Джуниор
 
Регистрация: 04.07.2016
Сообщений: 1
Смех

в WCrypt32.pas корявые декларации функций CryptoApi без учета 64-битности.

HCRYPTKEY = ULONG; // BAD DECLARATION !!!!
ULONG = CARDINAL. // ALWAYS 32-BIT VARIABLE !!!

Если глянуть в msdn to HCRYPTKEY это Handle, то есть тип THandle.

HCRYPTKEY = THANDLE; // GOOD PASCAL DECLARATION
THandle = NativeUInt;

Поменяйте у себя корректно типы в WCrypt32 и все будет работать в Win64 среде вызовов как положено.
Это кстати касается и
HCRYPTPROV = ULONG;
HCRYPTHASH = ULONG;
AOXOA вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
CryptoApi Дмитрий5040 Общие вопросы Delphi 1 07.02.2013 02:36
Сертификат CryptoApi Dianochka Помощь студентам 0 13.05.2012 12:39
CryptGenRandom,CryptoAPI tiger Помощь студентам 0 25.05.2011 00:10
Проблемное CryptoAPI Namelles One Win Api 1 07.11.2008 08:27
CryptoAPI: вопрос по ф-ям Lisi4ka Компоненты Delphi 1 28.09.2008 14:53