Roger, That is true but I thought by passing a pointer value into the C procedure and using a memcpy (not a strcpy) with a string length I should be able to get around that. -Mike

I have created the following test case to show how to preserve null (\0) characters during Perl/C string conversion. You need to use newSVpvn to convert C char * to Perl string while preserving '\0' in the char *. I suspect the Win32::API module uses newSVpvf or similar that does not preserve the null characters. I would roll my own ShareMem in XS instead of creating a separate DLL and accessing it via Win32::API.


# ----- Makefile.PL -----
use ExtUtils::MakeMaker;
WriteMakefile(
    'NAME'            => 'StringTest',
    'VERSION_FROM'    => 'StringTest.pm',
    'PREREQ_PM'        => {},
    'LIBS'            => [],
    'DEFINE'        => '',
    'INC'            => '',
);


# ----- StringTest.pm -----
package StringTest;

require 5.00503;
use strict;
use warnings;

require Exporter;
require DynaLoader;

our @ISA = qw(Exporter DynaLoader);
our @EXPORT_OK = qw(set);
our $VERSION = '1.00';

bootstrap StringTest $VERSION;

1;


# ------ StringTest.xs ------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

MODULE = StringTest    PACKAGE = StringTest

SV *set(SV *s, IV l)
    CODE:
    {
      char *str = malloc(l);
      int i;

      memcpy(str, SvPVX(s, l), l);     // OK

      // debug the copy
      printf("(l=%d) ", l);
      for (i=0;i<l;i++) { printf("%02x ", str[i]); }
      printf("\n");

      RETVAL = newSVpvn(str, l);  // newSVpvn preserves null

      free(str);
    }
    OUTPUT:
    RETVAL


# ----- stest.pl ------
use strict;
use StringTest qw/set/;

my $str = "A\0B\0C\0";                 # a string with nulls

print "OLD: $str\n";

my $new_str = set($str, length($str)); # create a new string

print "NEW: $new_str\n";


# ------ OUTPUT ------
OLD: A B C
(l=6) 41 00 42 00 43 00
NEW: A B C
[download]

The following are the procedures I use to set and get from the shared memory area. I threw the structure in as a reference. Ignore the red +s as they indicate a line wrap. -Mike

//***********************************************************
//*                                                            *
//*                  Structure Definitions                    *
//*                                                            *
//***********************************************************
struct shmInfoEntry
{
    char shmBufferName[25];
    DWORD shmBufferSize;
    DWORD shmDataSize;
    HANDLE shmHMapFile;
    LPVOID shmLpMapAddress;
};

//***********************************************************
//*Name:        SetSharedMem                                *
//*Function:    SetSharedMem sets the value of the shared    *
//*                memory area reference by shareIndex            *
//*Return Vals:    0 = Operation Failed                        *
//*                1 = Operation Succeeded                        *
//***********************************************************
int __export __stdcall SetSharedMem(const int shareIndex, const void* 
+lpszBuf, const DWORD bufLength) 
{
    LPVOID recordOffset;
    struct shmInfoEntry tempShmEntry;
// DEGUG FOR SEEING IF lpszBuf is writing out the proper stuff
//    FILE *crapfile;
//    
//    // Write out file
//    crapfile=fopen("crapfile.txt","wb");
//    fwrite(lpszBuf,bufLength,1,crapfile);
//    fclose(crapfile);
    if (shareIndex > lastShmIndex)
    {
        // Have To Use A Existing Share
        return 0;
    }
    // Get Record Offset To Struct Of Info
    recordOffset = (DWORD) lpvMem + (sizeof(int) + (shareIndex * sizeO
+fInfoStruct));
    // Copy Struct From Shared Memory
    memcpy(&tempShmEntry,recordOffset,sizeOfInfoStruct);
    if (bufLength > tempShmEntry.shmBufferSize)
    {
        //NOTE: THIS IS BAD, RESIZE BUFFER OR FAIL
        return 0;
    }
    // Set Data Size
    tempShmEntry.shmDataSize = bufLength;
    // Save Data Size
    memcpy(recordOffset,&tempShmEntry,sizeOfInfoStruct);
    // lpMapAddress should be the first memory byte of the shared memo
+ry struct
    memcpy(tempShmEntry.shmLpMapAddress,lpszBuf,bufLength);
    return 1;
} 

//***********************************************************
//*Name:        GetSharedMem                                *
//*Function:    GetSharedMem gets the value of the shared    *
//*                memory area reference by shareIndex            *
//*Return Vals:    0 = Operation Failed                        *
//*                1 = Operation Succeeded                        *
//***********************************************************
int __export __stdcall GetSharedMem(const int shareIndex,void* lpszBuf
+, const DWORD bufLength)
{
    LPVOID recordOffset;
    struct shmInfoEntry tempShmEntry;
//    FILE *crapfile;

    if (shareIndex > lastShmIndex)
    {
        return 0;
    }
    // Get Record Offset To Struct Of Info
    recordOffset = (DWORD) lpvMem + (sizeof(int) + (shareIndex * sizeO
+fInfoStruct));
    // Copy Struct From Shared Memory
    memcpy(&tempShmEntry,recordOffset,sizeOfInfoStruct);
    if (bufLength > tempShmEntry.shmBufferSize)
    {
        //NOTE: THIS IS BAD, RESIZE BUFFER OR FAIL
        return 0;
    }
    // Grab Stuff Out Of Buffer
    memcpy(lpszBuf,tempShmEntry.shmLpMapAddress,bufLength);
    // Debugging what should be returned
//    crapfile=fopen("crapfile.txt","wb");
//    fwrite(lpszBuf,bufLength,1,crapfile);
//    fclose(crapfile);
    return 1;
}
[download]

I have updated the reply to your post ... here 326410

sub Unpack {
    my $type = $_[0];
    # ADDED
    if ($type eq "MYBUFFER*") {
        DEBUG "(PM)Type::Unpack: got packing 'c', is a pointer, unpack
+ing 'Z*' '$_[1]'\n";
        $_[1] = unpack("A*", $_[1]);
        DEBUG "(PM)Type::Unpack: returning '$_[1]'\n";
        return $_[1];
    }
    elsif(packing($type) eq 'c' and is_pointer($type)) {       
        DEBUG "(PM)Type::Unpack: got packing 'c', is a pointer, unpack
+ing 'Z*' '$_[1]'\n";
        $_[1] = unpack("Z*", $_[1]);
        DEBUG "(PM)Type::Unpack: returning '$_[1]'\n";
        return $_[1];
    }
    DEBUG "(PM)Type::Unpack: unpacking '".packing($type)."' '$_[1]'\n"
+; 
    $_[1] = unpack( packing($type), $_[1]);
    DEBUG "(PM)Type::Unpack: returning '$_[1]'\n";  
    return $_[1];
}
[download]

$GetSharedMem = Win32::API->new('shmdll', 'int GetSharedMem(int shareI
+ndex,MYBUFFER* lpszBuf, DWORD bufLength)');
[download]