90 lines
2.7 KiB
Plaintext
90 lines
2.7 KiB
Plaintext
**FREE
|
|
Ctl-opt MAIN(Main);
|
|
Ctl-opt DFTACTGRP(*NO) ACTGRP(*NEW);
|
|
|
|
dcl-pr QDCXLATE EXTPGM('QDCXLATE');
|
|
dataLen packed(5 : 0) CONST;
|
|
data char(32767) options(*VARSIZE);
|
|
conversionTable char(10) CONST;
|
|
end-pr;
|
|
|
|
dcl-pr Qc3CalculateHash EXTPROC('Qc3CalculateHash');
|
|
inputData pointer value;
|
|
inputDataLen int(10) const;
|
|
inputDataFormat char(8) const;
|
|
algorithmDscr char(16) const;
|
|
algorithmFormat char(8) const;
|
|
cryptoServiceProvider char(1) const;
|
|
cryptoDeviceName char(1) const options(*OMIT);
|
|
hash char(64) options(*VARSIZE : *OMIT);
|
|
errorCode char(32767) options(*VARSIZE);
|
|
end-pr;
|
|
|
|
dcl-c HEX_CHARS CONST('0123456789ABCDEF');
|
|
|
|
dcl-proc Main;
|
|
dcl-s inputData char(45);
|
|
dcl-s inputDataLen int(10) INZ(0);
|
|
dcl-s outputHash char(16);
|
|
dcl-s outputHashHex char(32);
|
|
dcl-ds algorithmDscr QUALIFIED;
|
|
hashAlgorithm int(10) INZ(0);
|
|
end-ds;
|
|
dcl-ds ERRC0100_NULL QUALIFIED;
|
|
bytesProvided int(10) INZ(0); // Leave at zero
|
|
bytesAvailable int(10);
|
|
end-ds;
|
|
|
|
dow inputDataLen = 0;
|
|
DSPLY 'Input: ' '' inputData;
|
|
inputData = %trim(inputData);
|
|
inputDataLen = %len(%trim(inputData));
|
|
DSPLY ('Input=' + inputData);
|
|
DSPLY ('InputLen=' + %char(inputDataLen));
|
|
if inputDataLen = 0;
|
|
DSPLY 'Input must not be blank';
|
|
endif;
|
|
enddo;
|
|
|
|
// Convert from EBCDIC to ASCII
|
|
QDCXLATE(inputDataLen : inputData : 'QTCPASC');
|
|
algorithmDscr.hashAlgorithm = 1; // MD5
|
|
// Calculate hash
|
|
Qc3CalculateHash(%addr(inputData) : inputDataLen : 'DATA0100' : algorithmDscr
|
|
: 'ALGD0500' : '0' : *OMIT : outputHash : ERRC0100_NULL);
|
|
// Convert to hex
|
|
CVTHC(outputHashHex : outputHash : 32);
|
|
DSPLY ('MD5: ' + outputHashHex);
|
|
return;
|
|
end-proc;
|
|
|
|
// This procedure is actually a MI, but I couldn't get it to bind so I wrote my own version
|
|
dcl-proc CVTHC;
|
|
dcl-pi *N;
|
|
target char(65534) options(*VARSIZE);
|
|
srcBits char(32767) options(*VARSIZE) CONST;
|
|
targetLen int(10) value;
|
|
end-pi;
|
|
dcl-s i int(10);
|
|
dcl-s lowNibble ind INZ(*OFF);
|
|
dcl-s inputOffset int(10) INZ(1);
|
|
dcl-ds dataStruct QUALIFIED;
|
|
numField int(5) INZ(0);
|
|
// IBM i is big-endian
|
|
charField char(1) OVERLAY(numField : 2);
|
|
end-ds;
|
|
|
|
for i = 1 to targetLen;
|
|
if lowNibble;
|
|
dataStruct.charField = %BitAnd(%subst(srcBits : inputOffset : 1) : X'0F');
|
|
inputOffset += 1;
|
|
else;
|
|
dataStruct.charField = %BitAnd(%subst(srcBits : inputOffset : 1) : X'F0');
|
|
dataStruct.numField /= 16;
|
|
endif;
|
|
%subst(target : i : 1) = %subst(HEX_CHARS : dataStruct.numField + 1 : 1);
|
|
lowNibble = NOT lowNibble;
|
|
endfor;
|
|
return;
|
|
end-proc;
|